From 9efec733b03d28bca854a6b9e8ef0fd8a3ee1264 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 11 Aug 2024 09:54:13 +0800 Subject: [PATCH] refactor: move [Dune_project_name] to [dune_lang] Signed-off-by: Rudi Grinberg --- bin/import.ml | 2 +- src/dune_lang/dune_lang.ml | 1 + .../dune_project_name.ml | 8 ++- .../dune_project_name.mli | 2 +- src/dune_rules/dune_rules.ml | 1 - src/dune_rules/import.ml | 1 + src/upgrader/dune_upgrader.ml | 59 +++++++++++-------- 7 files changed, 42 insertions(+), 32 deletions(-) rename src/{dune_rules => dune_lang}/dune_project_name.ml (88%) rename src/{dune_rules => dune_lang}/dune_project_name.mli (97%) diff --git a/bin/import.ml b/bin/import.ml index e098340df91..452bfaaa5c4 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -30,7 +30,6 @@ include struct module Workspace = Workspace module Package = Package module Dune_project = Dune_project - module Dune_project_name = Dune_project_name module Dune_package = Dune_package module Resolve = Resolve module Source_dir_status = Source_dir_status @@ -72,6 +71,7 @@ include struct module Source_kind = Source_kind module Package_info = Package_info module Section = Section + module Dune_project_name = Dune_project_name end module Log = Dune_util.Log diff --git a/src/dune_lang/dune_lang.ml b/src/dune_lang/dune_lang.ml index 18d0f89043c..8c8acc23f43 100644 --- a/src/dune_lang/dune_lang.ml +++ b/src/dune_lang/dune_lang.ml @@ -40,3 +40,4 @@ module Source_kind = Source_kind module Package_info = Package_info module Section = Section module Package = Package +module Dune_project_name = Dune_project_name diff --git a/src/dune_rules/dune_project_name.ml b/src/dune_lang/dune_project_name.ml similarity index 88% rename from src/dune_rules/dune_project_name.ml rename to src/dune_lang/dune_project_name.ml index f671a647fad..6eb215957d4 100644 --- a/src/dune_rules/dune_project_name.ml +++ b/src/dune_lang/dune_project_name.ml @@ -1,4 +1,4 @@ -open Import +open Stdune module T = struct type t = @@ -48,8 +48,10 @@ let named loc name = else User_error.raise ~loc [ Pp.textf "%S is not a valid Dune project name." name ] ;; -let decode = Dune_lang.Decoder.plain_string (fun ~loc s -> named loc s) -let encode n = Dune_lang.Encoder.string (to_string_hum n) +open Dune_sexp + +let decode = Decoder.plain_string (fun ~loc s -> named loc s) +let encode n = Encoder.string (to_string_hum n) let name = function | Anonymous _ -> None diff --git a/src/dune_rules/dune_project_name.mli b/src/dune_lang/dune_project_name.mli similarity index 97% rename from src/dune_rules/dune_project_name.mli rename to src/dune_lang/dune_project_name.mli index d7d783877af..0f04a5d748e 100644 --- a/src/dune_rules/dune_project_name.mli +++ b/src/dune_lang/dune_project_name.mli @@ -1,4 +1,4 @@ -open Import +open Stdune (** Invariants: - Named s -> s <> "" and s does not contain '.' or '/' - Anonymous p -> p is a local path in the source tree *) diff --git a/src/dune_rules/dune_rules.ml b/src/dune_rules/dune_rules.ml index a8054fd659e..58a068790ab 100644 --- a/src/dune_rules/dune_rules.ml +++ b/src/dune_rules/dune_rules.ml @@ -58,7 +58,6 @@ module Pp_spec_rules = Pp_spec_rules module Command = Command module Clflags = Clflags module Dune_project = Dune_project -module Dune_project_name = Dune_project_name module Source_tree = Source_tree module Source_dir_status = Source_dir_status module Dune_file0 = Dune_file0 diff --git a/src/dune_rules/import.ml b/src/dune_rules/import.ml index f8cf9c103f0..3fc6ac7df5d 100644 --- a/src/dune_rules/import.ml +++ b/src/dune_rules/import.ml @@ -99,6 +99,7 @@ include struct module Section = Section module Package_dependency = Package_dependency module Package_constraint = Package_constraint + module Dune_project_name = Dune_project_name end include Dune_engine.No_io diff --git a/src/upgrader/dune_upgrader.ml b/src/upgrader/dune_upgrader.ml index 858d1cac8e6..33d8bda94e0 100644 --- a/src/upgrader/dune_upgrader.ml +++ b/src/upgrader/dune_upgrader.ml @@ -3,12 +3,24 @@ open! Stdune include struct open Dune_rules module Dune_project = Dune_project - module Dune_project_name = Dune_project_name module Source_tree = Source_tree module Source_dir_status = Source_dir_status module Dune_file0 = Dune_file0 end +include struct + open Dune_sexp + module Atom = Atom + module Syntax = Syntax + module Ast = Ast + module Cst = Cst +end + +include struct + open Dune_lang + module Dune_project_name = Dune_project_name +end + module Console = Dune_console type rename_and_edit = @@ -30,17 +42,17 @@ type project_version = module Common = struct module Ast_tools = struct - open Dune_lang.Ast + open Ast let field_of_list ?more:(m = []) atoms = List (Loc.none, List.map atoms ~f:(fun a -> Atom (Loc.none, a)) @ m) ;; let make_foreign_stubs lang names flags = - let open Dune_lang.Atom in + let open Atom in let add_more name olist m = match olist with - | Some (_ :: more) -> field_of_list [ of_string name ] ~more :: m + | Some (_ :: more) -> field_of_list [ Atom.of_string name ] ~more :: m | _ -> m in let more = @@ -54,7 +66,7 @@ module Common = struct let rec replace_first old_name new_name = function | List (loc, Atom (loca, A atom) :: tll) :: tl when atom = old_name -> - List (loc, Atom (loca, Dune_lang.Atom.of_string new_name) :: tll) :: tl + List (loc, Atom (loca, Atom.of_string new_name) :: tll) :: tl | List (loc, Quoted_string (loca, str) :: tll) :: tl when str = old_name -> List (loc, Quoted_string (loca, new_name) :: tll) :: tl | hd :: tl -> hd :: replace_first old_name new_name tl @@ -84,7 +96,7 @@ module Common = struct ;; let bump_lang_version v = - let v = Dune_lang.Syntax.Version.to_string v in + let v = Syntax.Version.to_string v in function | List ( loc @@ -92,8 +104,7 @@ module Common = struct :: (Atom (_, A "dune") as dune) :: Atom (loc3, A _) :: tll ) - :: tl -> - List (loc, lang :: dune :: Atom (loc3, Dune_lang.Atom.of_string v) :: tll) :: tl + :: tl -> List (loc, lang :: dune :: Atom (loc3, Atom.of_string v) :: tll) :: tl | sexp -> sexp ;; @@ -118,9 +129,9 @@ module Common = struct end let read_and_parse path = - let csts = Dune_lang.Parser.load (Path.source path) ~mode:Cst in - let comments = Dune_lang.Cst.extract_comments csts in - let sexps = List.filter_map csts ~f:Dune_lang.Cst.abstract in + let csts = Dune_sexp.Parser.load (Path.source path) ~mode:Cst in + let comments = Cst.extract_comments csts in + let sexps = List.filter_map csts ~f:Cst.abstract in sexps, comments ;; @@ -140,8 +151,8 @@ module Common = struct ;; let string_of_sexps ~version sexps comments = - let new_csts = List.map sexps ~f:Dune_lang.Cst.concrete in - Dune_lang.Parser.insert_comments new_csts comments + let new_csts = List.map sexps ~f:Cst.concrete in + Dune_sexp.Parser.insert_comments new_csts comments |> Dune_lang.Format.pp_top_sexps ~version |> Format.asprintf "%a@?" Pp.to_fmt ;; @@ -159,13 +170,12 @@ module Common = struct fn ~binary:false (List.concat - [ [ sprintf "(lang dune %s)" (Dune_lang.Syntax.Version.to_string lang_version) - ] + [ [ sprintf "(lang dune %s)" (Syntax.Version.to_string lang_version) ] ; (match Dune_project.name project |> Dune_project_name.name with | None -> [] | Some s -> - [ Dune_lang.to_string - (List [ Dune_lang.atom "name"; Dune_lang.atom_or_quoted_string s ]) + [ Dune_sexp.to_string + (List [ Dune_sexp.atom "name"; Dune_sexp.atom_or_quoted_string s ]) ]) ]) ;; @@ -179,7 +189,7 @@ module V2 = struct if Ast_tools.is_in_fields [ "modes" ] fields then fields else - Dune_lang.Atom.( + Atom.( Ast_tools.field_of_list [ of_string "modes"; of_string "byte"; of_string "exe" ]) :: fields ;; @@ -213,13 +223,13 @@ module V2 = struct ;; let update_stanza = - let open Dune_lang.Ast in + let open Ast in function | List (loc, Atom (loca, A "alias") :: tl) as ast -> if Ast_tools.is_in_fields [ "action" ] tl then ( let tl = Ast_tools.replace_first "name" "alias" tl in - List (loc, Atom (loca, Dune_lang.Atom.of_string "rule") :: tl)) + List (loc, Atom (loca, Atom.of_string "rule") :: tl)) else ast | List (loc, Atom (loca, (A "executable" as atom)) :: tl) | List (loc, Atom (loca, (A "executables" as atom)) :: tl) -> @@ -237,15 +247,12 @@ module V2 = struct (* Was not using fmt *) | None -> sexps - @ [ Ast_tools.field_of_list - Dune_lang.Atom.[ of_string "formatting"; of_string "disabled" ] - ] + @ [ Ast_tools.field_of_list Atom.[ of_string "formatting"; of_string "disabled" ] ] (* Was using fmt *) | Some [ _; _; _ ] -> sexps (* Was using fmt enabled_for *) | Some (_ :: _ :: _ :: tl) -> - sexps - @ [ Ast_tools.field_of_list Dune_lang.Atom.[ of_string "formatting" ] ~more:tl ] + sexps @ [ Ast_tools.field_of_list Atom.[ of_string "formatting" ] ~more:tl ] (* Unexpected *) | _ -> sexps ;; @@ -339,7 +346,7 @@ let detect_project_version project dir = Unknown) else ( let project_dune_version = Dune_project.dune_version project in - let open Dune_lang.Syntax.Version.Infix in + let open Syntax.Version.Infix in if project_dune_version >= (2, 0) then Dune2_project else if project_dune_version >= (1, 0)