28737

Committed 20 Oct 2024 08:25PM UTC coverage: 6.911% (-0.007%) from 6.918%

Build # 28737

Build Type

push

github

Committed by

web-flow

Commit Message

refactor: move standard aliases to rules (#11030)

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Run Details

4 of 7 new or added lines in 3 files covered. (57.14%)

1 existing line in 1 file now uncovered.

2929 of 42380 relevant lines covered (6.91%)

26879.67 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

6.52

/src/dune_engine/alias.ml

open Import

module Name = struct
  include Dune_util.Alias_name

  let of_string s =
    match of_string_opt s with
    | Some s -> s
    | None -> Code_error.raise "invalid alias name" [ "s", Dyn.string s ]
  ;;

  let default = of_string "default"

  let parse_local_path (loc, p) =
    match Path.Local.parent p with
    | Some dir ->
      ( dir
      , (* TODO one day we should validate the name properly here *)
        Path.Local.basename p |> of_string_opt_loose |> Option.value_exn )
    | None ->
      User_error.raise
        ~loc
        [ Pp.textf "Invalid alias path: %S" (Path.Local.to_string_maybe_quoted p) ]
  ;;
end

module T : sig
  type t = private
    { dir : Path.Build.t
    ; name : Name.t
    }

  val make : Name.t -> dir:Path.Build.t -> t
  val of_user_written_path : loc:Loc.t -> Path.t -> t
end = struct
  type t =
    { dir : Path.Build.t
    ; name : Name.t
    }

  let make name ~dir = { dir; name }

  let of_user_written_path ~loc path =
    match Path.as_in_build_dir path with
    | Some path ->
      let name =
        Path.Build.basename path |> Name.of_string_opt_loose |> Option.value_exn
      in
      { dir = Path.Build.parent_exn path; name }
    | None ->
      User_error.raise
        ~loc
        [ Pp.text "Invalid alias!"
        ; Pp.textf
            "Tried to reference path outside build dir: %S"
            (Path.to_string_maybe_quoted path)
        ]
  ;;
end

include T

let compare { dir; name } t =
  let open Ordering.O in
  let= () = Name.compare name t.name in
  Path.Build.compare dir t.dir
;;

let equal x y = compare x y = Eq
let hash { dir; name } = Tuple.T2.hash Path.Build.hash Name.hash (dir, name)

let to_dyn { dir; name } =
  let open Dyn in
  Record [ "dir", Path.Build.to_dyn dir; "name", Name.to_dyn name ]
;;

let name t = t.name
let dir t = t.dir
let fully_qualified_name t = Path.Build.relative t.dir (Name.to_string t.name)

let get_ctx (path : Path.Build.t) =
  match Path.Build.extract_first_component path with
  | None -> None
  | Some (name, sub) ->
    (match Context_name.of_string_opt name with
     | None -> None
     | Some ctx -> Some (ctx, Path.Source.of_local sub))
;;

let describe ?(loc = Loc.none) alias =
  let open Pp.O in
  let pp =
    match get_ctx alias.dir with
    | None ->
      Pp.textf "invalid-alias %s" (Path.Build.to_string (fully_qualified_name alias))
    | Some (ctx, dir_in_context) ->
      let pp =
        Pp.textf "alias "
        ++ Pp.verbatim
             (Path.Source.to_string_maybe_quoted
                (Path.Source.relative dir_in_context (Name.to_string alias.name)))
      in
      if Context_name.is_default ctx
      then pp
      else pp ++ Pp.textf " (context %s)" (Context_name.to_string ctx)
  in
  if Loc.is_none loc then pp else pp ++ Pp.textf " in %s" (Loc.to_file_colon_line loc)
;;

1	open Import
2
3	module Name = struct
4	include Dune_util.Alias_name
5
6	let of_string s =
7	match of_string_opt s with	621✔
8	\| Some s -> s	621✔
9	\| None -> Code_error.raise "invalid alias name" [ "s", Dyn.string s ]	×
10	;;
11
12	let default = of_string "default"	39✔
13
14	let parse_local_path (loc, p) =
15	match Path.Local.parent p with	×
16	\| Some dir ->	×
17	( dir
18	, (* TODO one day we should validate the name properly here *)
19	Path.Local.basename p \|> of_string_opt_loose \|> Option.value_exn )	×
20	\| None ->	×
21	User_error.raise
22	~loc
23	[ Pp.textf "Invalid alias path: %S" (Path.Local.to_string_maybe_quoted p) ]	×
24	;;
25	end
26
27	module T : sig
28	type t = private
29	{ dir : Path.Build.t
30	; name : Name.t
31	}
32
33	val make : Name.t -> dir:Path.Build.t -> t
34	val of_user_written_path : loc:Loc.t -> Path.t -> t
35	end = struct
36	type t =
37	{ dir : Path.Build.t
38	; name : Name.t
39	}
40
41	let make name ~dir = { dir; name }	×
42
43	let of_user_written_path ~loc path =
44	match Path.as_in_build_dir path with	×
45	\| Some path ->	×
46	let name =
47	Path.Build.basename path \|> Name.of_string_opt_loose \|> Option.value_exn	×
48	in
49	{ dir = Path.Build.parent_exn path; name }	×
50	\| None ->	×
51	User_error.raise
52	~loc
53	[ Pp.text "Invalid alias!"	×
54	; Pp.textf	×
55	"Tried to reference path outside build dir: %S"
56	(Path.to_string_maybe_quoted path)	×
57	]
58	;;
59	end
60
61	include T
62
63	let compare { dir; name } t =
64	let open Ordering.O in	×
65	let= () = Name.compare name t.name in	×
66	Path.Build.compare dir t.dir	×
67	;;
68
69	let equal x y = compare x y = Eq	×
70	let hash { dir; name } = Tuple.T2.hash Path.Build.hash Name.hash (dir, name)	×
71
72	let to_dyn { dir; name } =
73	let open Dyn in	×
74	Record [ "dir", Path.Build.to_dyn dir; "name", Name.to_dyn name ]	×
75	;;
76
77	let name t = t.name	×
78	let dir t = t.dir	×
79	let fully_qualified_name t = Path.Build.relative t.dir (Name.to_string t.name)	×
80
81	let get_ctx (path : Path.Build.t) =
UNCOV 82	match Path.Build.extract_first_component path with	×
83	\| None -> None	×
84	\| Some (name, sub) ->	×
85	(match Context_name.of_string_opt name with
86	\| None -> None	×
87	\| Some ctx -> Some (ctx, Path.Source.of_local sub))	×
88	;;
89
90	let describe ?(loc = Loc.none) alias =	×
91	let open Pp.O in	×
92	let pp =
93	match get_ctx alias.dir with
94	\| None ->	×
95	Pp.textf "invalid-alias %s" (Path.Build.to_string (fully_qualified_name alias))	×
96	\| Some (ctx, dir_in_context) ->	×
97	let pp =
98	Pp.textf "alias "	×
99	++ Pp.verbatim	×
100	(Path.Source.to_string_maybe_quoted	×
101	(Path.Source.relative dir_in_context (Name.to_string alias.name)))	×
102	in
103	if Context_name.is_default ctx	×
104	then pp	×
105	else pp ++ Pp.textf " (context %s)" (Context_name.to_string ctx)	×
106	in
107	if Loc.is_none loc then pp else pp ++ Pp.textf " in %s" (Loc.to_file_colon_line loc)	×
108	;;

ocaml / dune / 28737

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous