Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use OCaml Objects - with Capabilities as First Class Modules #46

Draft
wants to merge 8 commits into
base: main
Choose a base branch
from
Draft

Use OCaml Objects - with Capabilities as First Class Modules #46

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
a85a836
Define object classes for traits
mbarbin Dec 25, 2024
1e07c62
Add class for trait add
mbarbin Dec 25, 2024
3f50338
Continue adding classes
mbarbin Dec 26, 2024
b9dbfce
Simplify method definition
mbarbin Dec 26, 2024
8b28998
Complete trait classes
mbarbin Dec 26, 2024
dea8872
Use trait classes in vcs
mbarbin Dec 26, 2024
f9ea53e
Clean up usages of provider
mbarbin Dec 26, 2024
93116cf
Separate state and capabilities
mbarbin Dec 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 2 additions & 16 deletions dune-project
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,9 +44,7 @@
(>= v0.17)
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))))
(>= 0.33))))

(package
(name vcs-base)
Expand Down Expand Up @@ -92,8 +90,6 @@
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))
(vcs
(= :version))))

Expand Down Expand Up @@ -160,8 +156,6 @@
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))
(sexplib0
(and
(>= v0.17)
Expand Down Expand Up @@ -192,8 +186,6 @@
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))
(sexplib0
(and
(>= v0.17)
Expand Down Expand Up @@ -224,8 +216,6 @@
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))
(sexplib0
(and
(>= v0.17)
Expand Down Expand Up @@ -334,8 +324,6 @@
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))
(re
(>= 1.8.0))
(sexp_pretty
Expand Down Expand Up @@ -410,6 +398,4 @@
(>= v0.17)
(< v0.18)))
(ppxlib
(>= 0.33))
(provider
(>= 0.0.11))))
(>= 0.33))))
20 changes: 2 additions & 18 deletions lib/vcs/src/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,28 +13,12 @@
Sexplib0
-open
Sexplib0.Sexp_conv)
(libraries astring fpath fpath-sexp0 provider)
(libraries astring fpath fpath-sexp0)
(instrumentation
(backend bisect_ppx))
(lint
(pps ppx_js_style -allow-let-operators -check-doc-comments))
(modules_without_implementation
trait_add
trait_branch
trait_commit
trait_config
trait_file_system
trait_git
trait_init
trait_log
trait_ls_files
trait_name_status
trait_num_status
trait_refs
trait_rev_parse
trait_show
validated_string_intf
vcs_interface)
(modules_without_implementation validated_string_intf vcs_interface)
(preprocess
(pps
-unused-code-warnings=force
Expand Down
7 changes: 6 additions & 1 deletion lib/vcs/src/import.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -182,7 +182,12 @@ module Option = struct
end

module Ordering = struct
include Provider.Private.Import.Ordering
type t =
| Less
| Equal
| Greater

let of_int i = if i < 0 then Less else if i = 0 then Equal else Greater
end

module Queue = struct
Expand Down
3 changes: 1 addition & 2 deletions lib/vcs/src/non_raising.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,8 +24,7 @@ open! Import
module type M = Vcs_interface.Error_S
module type S = Vcs_interface.S

module Make (M : M) :
S with type 'a t := 'a Vcs0.t and type 'a result := ('a, M.t) Result.t = struct
module Make (M : M) : S with type 'a result := ('a, M.t) Result.t = struct
let try_with f =
match f () with
| r -> Ok r
Expand Down
3 changes: 1 addition & 2 deletions lib/vcs/src/non_raising.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,5 +29,4 @@
module type M = Vcs_interface.Error_S
module type S = Vcs_interface.S

module Make (M : M) :
S with type 'a t := 'a Vcs0.t and type 'a result := ('a, M.t) Result.t
module Make (M : M) : S with type 'a result := ('a, M.t) Result.t
199 changes: 30 additions & 169 deletions lib/vcs/src/trait.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,173 +19,34 @@
(* <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively. *)
(*******************************************************************************)

type add = [ `Add of add_ty ]
and add_ty

module Add = struct
module type S = Trait_add.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type branch = [ `Branch of branch_ty ]
and branch_ty

module Branch = struct
module type S = Trait_branch.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type commit = [ `Commit of commit_ty ]
and commit_ty

module Commit = struct
module type S = Trait_commit.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type config = [ `Config of config_ty ]
and config_ty

module Config = struct
module type S = Trait_config.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
module Add = Trait_add
module Branch = Trait_branch
module Commit = Trait_commit
module Config = Trait_config
module File_system = Trait_file_system
module Git = Trait_git
module Init = Trait_init
module Log = Trait_log
module Ls_files = Trait_ls_files
module Name_status = Trait_name_status
module Num_status = Trait_num_status
module Refs = Trait_refs
module Rev_parse = Trait_rev_parse
module Show = Trait_show

class type ['a] t = object
inherit ['a] Add.t
inherit ['a] Branch.t
inherit ['a] Commit.t
inherit ['a] Config.t
inherit ['a] File_system.t
inherit ['a] Git.t
inherit ['a] Init.t
inherit ['a] Log.t
inherit ['a] Ls_files.t
inherit ['a] Name_status.t
inherit ['a] Num_status.t
inherit ['a] Refs.t
inherit ['a] Rev_parse.t
inherit ['a] Show.t
end

type file_system = [ `File_system of file_system_ty ]
and file_system_ty

module File_system = struct
module type S = Trait_file_system.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type git = [ `Git of git_ty ]
and git_ty

module Git = struct
module type S = Trait_git.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type init = [ `Init of init_ty ]
and init_ty

module Init = struct
module type S = Trait_init.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type log = [ `Log of log_ty ]
and log_ty

module Log = struct
module type S = Trait_log.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type ls_files = [ `Ls_files of ls_files_ty ]
and ls_files_ty

module Ls_files = struct
module type S = Trait_ls_files.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type name_status = [ `Name_status of name_status_ty ]
and name_status_ty

module Name_status = struct
module type S = Trait_name_status.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type num_status = [ `Num_status of num_status_ty ]
and num_status_ty

module Num_status = struct
module type S = Trait_num_status.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type refs = [ `Refs of refs_ty ]
and refs_ty

module Refs = struct
module type S = Trait_refs.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type rev_parse = [ `Rev_parse of rev_parse_ty ]
and rev_parse_ty

module Rev_parse = struct
module type S = Trait_rev_parse.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type show = [ `Show of show_ty ]
and show_ty

module Show = struct
module type S = Trait_show.S

include Provider.Trait.Create (struct
type 'a module_type = (module S with type t = 'a)
end)
end

type t =
[ add
| branch
| commit
| config
| file_system
| git
| init
| log
| ls_files
| name_status
| num_status
| refs
| rev_parse
| show
]
Loading
Loading