diff --git a/src/alire/alire-roots-editable.adb b/src/alire/alire-roots-editable.adb index a54d4f020..1cab170c3 100644 --- a/src/alire/alire-roots-editable.adb +++ b/src/alire/alire-roots-editable.adb @@ -373,7 +373,8 @@ package body Alire.Roots.Editable is Crate : Alire.Optional.Crate_Name; Origin : URL; Ref : String := ""; - Branch : String := "") + Branch : String := ""; + Subdir : Relative_Path := "") is --------------------------- @@ -436,7 +437,8 @@ package body Alire.Roots.Editable is New_Pin : User_Pins.Pin := User_Pins.New_Remote (URL => Origin, Commit => Ref, - Branch => Branch); + Branch => Branch, + Subdir => Subdir); Destination : constant Absolute_Path := New_Pin.Deploy_Path (Crate, This.Edit.Pins_Dir); @@ -444,6 +446,9 @@ package body Alire.Roots.Editable is package Adirs renames Ada.Directories; begin + -- TODO: Probably need to ensure the subdir exists and there is a + -- alire.toml manifest. Where this should go? + -- Put in place the checkout, as it is valid if we reached this point if not Adirs.Exists (This.Edit.Pins_Dir) then @@ -464,7 +469,8 @@ package body Alire.Roots.Editable is Crate, User_Pins.New_Remote (URL => Origin, Commit => Ref, - Branch => Branch)); + Branch => Branch, + Subdir => Subdir)); This.Reload_Manifest; -- And update lockfile. We need to call Deploy on the pin (although diff --git a/src/alire/alire-roots-editable.ads b/src/alire/alire-roots-editable.ads index 8fea2cfb1..e57088f41 100644 --- a/src/alire/alire-roots-editable.ads +++ b/src/alire/alire-roots-editable.ads @@ -99,7 +99,8 @@ package Alire.Roots.Editable is Crate : Optional.Crate_Name; Origin : URL; Ref : String := ""; - Branch : String := "") + Branch : String := ""; + Subdir : Relative_Path := "") with Pre => (not (Ref /= "" and then Branch /= "") or else raise Checked_Error with diff --git a/src/alire/alire-user_pins.adb b/src/alire/alire-user_pins.adb index ea0c9ffc3..783c302d5 100644 --- a/src/alire/alire-user_pins.adb +++ b/src/alire/alire-user_pins.adb @@ -16,6 +16,7 @@ package body Alire.User_Pins is package Keys is Branch : constant String := "branch"; Commit : constant String := "commit"; + Subdir : constant String := "subdir"; Internal : constant String := "lockfiled"; Path : constant String := "path"; URL : constant String := "url"; @@ -42,14 +43,16 @@ package body Alire.User_Pins is -- New_Remote -- ---------------- - function New_Remote (URL : Alire.URL; + function New_Remote (URL : Alire.URL; Commit : String := ""; - Branch : String := "") + Branch : String := ""; + Subdir : Alire.Relative_Path := "") return Pin is (Kind => To_Git, URL => +URL, Commit => +Commit, Branch => +Branch, + Subdir => +Subdir, Local_Path => <>); ----------- @@ -90,6 +93,9 @@ package body Alire.User_Pins is then ", branch='" & (+This.Branch) & "'" elsif This.Commit /= "" then ", commit='" & (+This.Commit) & "'" + else "") + & (if This.Subdir /= "" + then ", subdir='" & (+This.Subdir) & "'" else "")) & " }"); @@ -270,8 +276,12 @@ package body Alire.User_Pins is -- At this point, we have the sources at Destination. Last checks ensue. declare - Root : Roots.Optional.Root := - Roots.Optional.Detect_Root (Destination); + use Directories.Operators; -- "/" + + Subdir : constant String := +This.Subdir; + Root : Roots.Optional.Root := Roots.Optional.Detect_Root + ((if Subdir = "" then Destination + else Destination / Subdir)); begin -- Check crate name mismatch @@ -398,6 +408,11 @@ package body Alire.User_Pins is Result.Branch := +This.Checked_Pop (Keys.Branch, TOML_String).As_String; end if; + + if This.Contains (Keys.Subdir) then + Result.Subdir := + +This.Checked_Pop (Keys.Subdir, TOML_String).As_String; + end if; end return; else @@ -465,6 +480,7 @@ package body Alire.User_Pins is TOML_String).As_String, Branch => <>, Commit => <>, + Subdir => <>, Local_Path => <>); begin if This.Contains (Keys.Branch) @@ -488,6 +504,13 @@ package body Alire.User_Pins is "branch cannot be the empty string"); end if; + if This.Contains (Keys.Subdir) then + Result.Subdir := + +This.Checked_Pop (Keys.Subdir, TOML_String).As_String; + This.Assert (+Result.Subdir /= "", + "subdir cannot be the empty string"); + end if; + -- TEST: empty branch value This.Report_Extra_Keys; @@ -568,6 +591,12 @@ package body Alire.User_Pins is Table.Set (Keys.Branch, Create_String (Branch (This).Element.Ptr.all)); end if; + + -- TODO: Should this use the "VFS.Attempt_Portable"? + if Subdir (This).Has_Element then + Table.Set (Keys.Subdir, + Create_String (Subdir (This).Element.Ptr.all)); + end if; end if; Table.Set (Keys.Path, diff --git a/src/alire/alire-user_pins.ads b/src/alire/alire-user_pins.ads index ab90332ca..9da08bbdf 100644 --- a/src/alire/alire-user_pins.ads +++ b/src/alire/alire-user_pins.ads @@ -62,9 +62,10 @@ package Alire.User_Pins is -- Remote pins - function New_Remote (URL : Alire.URL; + function New_Remote (URL : Alire.URL; Commit : String := ""; - Branch : String := "") + Branch : String := ""; + Subdir : Alire.Relative_Path := "") return Pin with Pre => Commit = "" or else VCSs.Git.Is_Valid_Commit (Commit), @@ -79,6 +80,9 @@ package Alire.User_Pins is function Commit (This : Pin) return Optional.String with Pre => This.Is_Remote; + function Subdir (This : Pin) return Optional.String + with Pre => This.Is_Remote; + function TTY_URL_With_Reference (This : Pin; Detailed : Boolean := False) return String @@ -137,6 +141,7 @@ private URL : UString; Branch : UString; -- Optional Commit : UString; -- Optional + Subdir : UString; -- Optional Local_Path : Unbounded_Absolute_Path; -- Empty until the pin is locally deployed when To_Path => @@ -164,6 +169,15 @@ private then Optional.Strings.Empty else Optional.Strings.Unit (+This.Commit)); + ------------ + -- Subdir -- + ------------ + + function Subdir (This : Pin) return Optional.String + is (if +This.Subdir = "" + then Optional.Strings.Empty + else Optional.Strings.Unit (+This.Subdir)); + --------------- -- Is_Remote -- --------------- diff --git a/src/alr/alr-commands-pin.adb b/src/alr/alr-commands-pin.adb index ec1899266..661bbb7ad 100644 --- a/src/alr/alr-commands-pin.adb +++ b/src/alr/alr-commands-pin.adb @@ -190,7 +190,8 @@ package body Alr.Commands.Pin is (Crate => Optional_Crate, Origin => Cmd.URL.all, Ref => Cmd.Commit.all, - Branch => Cmd.Branch.all); + Branch => Cmd.Branch.all, + Subdir => Cmd.Subdir.all); else @@ -257,9 +258,11 @@ package body Alr.Commands.Pin is & " instead of looking for indexed releases." & " An optional reference can be specified with --commit;" & " the pin will be frozen at the commit currently matching" - & " the reference. Alternatively, a branch to track can be" - & " specified with --branch. Use `alr update` to refresh the" - & " tracking pin contents.") + & " the reference. Alternatively, a branch to track can be" + & " specified with --branch. Finally, if pinning a monorepo," + & " the relative path to the crate can be specified with" + & " --subdir. Use `alr update` to refresh the tracking pin" + & " contents.") ); -------------------- @@ -297,6 +300,14 @@ package body Alr.Commands.Pin is Argument => "REF", Help => "Reference to be retrieved from repository"); + Define_Switch + (Config => Config, + Output => Cmd.Subdir'Access, + Long_Switch => "--subdir=", + Argument => "PATH", + Help => + "Path to the crate relative to the root of the repository"); + Define_Switch (Config => Config, Output => Cmd.URL'Access, diff --git a/src/alr/alr-commands-pin.ads b/src/alr/alr-commands-pin.ads index 8a9d8803f..e70bf2341 100644 --- a/src/alr/alr-commands-pin.ads +++ b/src/alr/alr-commands-pin.ads @@ -30,7 +30,7 @@ package Alr.Commands.Pin is overriding function Usage_Custom_Parameters (Cmd : Command) return String is ("[[crate[=]]" - & " | crate --use= [--commit=REF] [--branch=NAME]" + & " | crate --use= [--commit=REF] [--branch=NAME] [--subdir=PATH]" & " | --all]"); private @@ -38,6 +38,7 @@ private type Command is new Commands.Command with record Branch : aliased GNAT.Strings.String_Access; Commit : aliased GNAT.Strings.String_Access; + Subdir : aliased GNAT.Strings.String_Access; Pin_All : aliased Boolean; Unpin : aliased Boolean; URL : aliased GNAT.Strings.String_Access; diff --git a/src/alr/alr-commands-withing.adb b/src/alr/alr-commands-withing.adb index bd500daec..95ac7c082 100644 --- a/src/alr/alr-commands-withing.adb +++ b/src/alr/alr-commands-withing.adb @@ -205,7 +205,8 @@ package body Alr.Commands.Withing is (Crate => Crate, Origin => Cmd.URL.all, Ref => Cmd.Commit.all, - Branch => Cmd.Branch.all); + Branch => Cmd.Branch.all, + Subdir => Cmd.Subdir.all); else @@ -360,8 +361,10 @@ package body Alr.Commands.Withing is & " An optional reference can be specified with --commit;" & " the pin will be frozen at the commit currently matching" & " the reference. Alternatively, a branch to track can be" - & " specified with --branch. Use `alr update` to refresh the" - & " tracking pin contents.") + & " specified with --branch. Finally, if pinning a monorepo," + & " the relative path to the crate can be specified with" + & " --subdir. Use `alr update` to refresh the tracking pin" + & " contents.") .New_Line .Append ("* Adding dependencies from a GPR file:") .Append ("The project file given with --from will be scanned looking" @@ -417,6 +420,14 @@ package body Alr.Commands.Withing is Argument => "REF", Help => "Commit to retrieve from repository"); + Define_Switch + (Config => Config, + Output => Cmd.Subdir'Access, + Long_Switch => "--subdir=", + Argument => "PATH", + Help => + "Path to the crate relative to the root of the repository"); + Define_Switch (Config => Config, Output => Cmd.URL'Access, diff --git a/src/alr/alr-commands-withing.ads b/src/alr/alr-commands-withing.ads index a89cd7dab..f5fff47b4 100644 --- a/src/alr/alr-commands-withing.ads +++ b/src/alr/alr-commands-withing.ads @@ -29,7 +29,8 @@ package Alr.Commands.Withing is overriding function Usage_Custom_Parameters (Cmd : Command) return String is ("[{ [--del] [versions]..." & " | --from ..." - & " | [versions] --use [--commit REF] [--branch NAME]} ]" + & " | [versions] --use " + & " [--commit REF] [--branch NAME] [--subdir PATH]} ]" & " | --solve | --tree | --versions"); private @@ -37,6 +38,7 @@ private type Command is new Commands.Command with record Branch : aliased GNAT.Strings.String_Access; Commit : aliased GNAT.Strings.String_Access; + Subdir : aliased GNAT.Strings.String_Access; Del : aliased Boolean := False; From : aliased Boolean := False; Graph : aliased Boolean := False;