Skip to content

Selective: move [branch] in core #93

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

Merged
xvw merged 1 commit into from
Feb 25, 2021
Merged

Selective: move [branch] in core #93

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
2 changes: 1 addition & 1 deletion lib/preface_make/free_selective.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ module Over_functor (F : Preface_specs.Functor.CORE) = struct
;;
end

module S = Selective.Over_functor (Functor) (Core)
module S = Selective.Over_functor_via_select (Functor) (Core)

module Transformation (Selective : Preface_specs.Selective.CORE) = struct
type natural_transformation = { transform : 'a. 'a f -> 'a Selective.t }
Expand Down
104 changes: 91 additions & 13 deletions lib/preface_make/selective.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,24 @@
open Preface_core.Fun

module Core_over_functor
module Branch_via_select
(Functor : Preface_specs.Functor.CORE)
(Select : Preface_specs.Selective.CORE_WITH_SELECT
with type 'a t = 'a Functor.t) =
struct
let branch s l r =
let a = Functor.map Either.(map_right left) s
and b = Functor.map (compose_right_to_left Either.right) l in
Select.select (Select.select a b) r
;;
end

module Select_via_branch
(Select : Preface_specs.Selective.CORE_WITH_PURE_AND_BRANCH) =
struct
let select x y = Select.branch x y (Select.pure id)
end

module Core_over_functor_via_select
(Functor : Preface_specs.Functor.CORE)
(Select : Preface_specs.Selective.CORE_WITH_PURE_AND_SELECT
with type 'a t = 'a Functor.t) :
Expand All @@ -16,29 +34,59 @@ module Core_over_functor
let apply f x = select (map Either.left f) (map ( |> ) x)
end

include Branch_via_select (Functor) (Select)
include Applicative.Core_via_apply (Ap)
end

module Core_over_applicative
module Core_over_functor_via_branch
(Functor : Preface_specs.Functor.CORE)
(Branch : Preface_specs.Selective.CORE_WITH_PURE_AND_BRANCH
with type 'a t = 'a Functor.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Functor.t = struct
include Functor
include Branch
include Select_via_branch (Branch)

module Ap = struct
type nonrec 'a t = 'a t

let pure x = pure x

let apply f x = select (map Either.left f) (map ( |> ) x)
end

include Applicative.Core_via_apply (Ap)
end

module Core_over_applicative_via_select
(Applicative : Preface_specs.APPLICATIVE)
(Select : Preface_specs.Selective.CORE_WITH_SELECT
with type 'a t = 'a Applicative.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Applicative.t = struct
include Applicative
include Select
include Branch_via_select (Applicative) (Select)
end

module Core_over_applicative_via_branch
(Applicative : Preface_specs.APPLICATIVE)
(Branch : Preface_specs.Selective.CORE_WITH_BRANCH
with type 'a t = 'a Applicative.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Applicative.t = struct
include Applicative
include Branch

include Select_via_branch (struct
let pure = pure

include Branch
end)
end

module Operation (Core : Preface_specs.Selective.CORE) :
Preface_specs.Selective.OPERATION with type 'a t = 'a Core.t = struct
include Applicative.Operation (Core)

let branch s l r =
let open Core in
let a = map Either.(map_right left) s
and b = map (compose_right_to_left Either.right) l in
select (select a b) r
;;

let if_ predicate if_true unless =
let open Core in
branch
Expand Down Expand Up @@ -105,12 +153,12 @@ module Via
module Syntax = Syntax
end

module Over_functor
module Over_functor_via_select
(Functor : Preface_specs.Functor.CORE)
(Select : Preface_specs.Selective.CORE_WITH_PURE_AND_SELECT
with type 'a t = 'a Functor.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Select.t = struct
module Core = Core_over_functor (Functor) (Select)
module Core = Core_over_functor_via_select (Functor) (Select)
module Operation = Operation (Core)
module Infix = Infix (Core) (Operation)
module Syntax = Syntax (Core)
Expand All @@ -120,12 +168,42 @@ module Over_functor
include Syntax
end

module Over_applicative
module Over_functor_via_branch
(Functor : Preface_specs.Functor.CORE)
(Branch : Preface_specs.Selective.CORE_WITH_PURE_AND_BRANCH
with type 'a t = 'a Functor.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Branch.t = struct
module Core = Core_over_functor_via_branch (Functor) (Branch)
module Operation = Operation (Core)
module Infix = Infix (Core) (Operation)
module Syntax = Syntax (Core)
include Core
include Operation
include Infix
include Syntax
end

module Over_applicative_via_select
(Applicative : Preface_specs.APPLICATIVE)
(Select : Preface_specs.Selective.CORE_WITH_SELECT
with type 'a t = 'a Applicative.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Select.t = struct
module Core = Core_over_applicative (Applicative) (Select)
module Core = Core_over_applicative_via_select (Applicative) (Select)
module Operation = Operation (Core)
module Infix = Infix (Core) (Operation)
module Syntax = Syntax (Core)
include Core
include Operation
include Infix
include Syntax
end

module Over_applicative_via_branch
(Applicative : Preface_specs.APPLICATIVE)
(Branch : Preface_specs.Selective.CORE_WITH_BRANCH
with type 'a t = 'a Applicative.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Branch.t = struct
module Core = Core_over_applicative_via_branch (Applicative) (Branch)
module Operation = Operation (Core)
module Infix = Infix (Core) (Operation)
module Syntax = Syntax (Core)
Expand Down
44 changes: 36 additions & 8 deletions lib/preface_make/selective.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,20 +6,34 @@

Standard way to build [Selective Functor]. *)

(** Incarnation of a [Selective] over an [Applicative]. *)
module Over_applicative
(** Incarnation of a [Selective] over an [Applicative] using [select]. *)
module Over_applicative_via_select
(Applicative : Preface_specs.APPLICATIVE)
(Select : Preface_specs.Selective.CORE_WITH_SELECT
with type 'a t = 'a Applicative.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Select.t

(** Incarnation of a [Selective] over a [Functor]. *)
module Over_functor
(** Incarnation of a [Selective] over an [Applicative] using branch. *)
module Over_applicative_via_branch
(Applicative : Preface_specs.APPLICATIVE)
(Branch : Preface_specs.Selective.CORE_WITH_BRANCH
with type 'a t = 'a Applicative.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Branch.t

(** Incarnation of a [Selective] over a [Functor] using [select] and [pure]. *)
module Over_functor_via_select
(Functor : Preface_specs.Functor.CORE)
(Select : Preface_specs.Selective.CORE_WITH_PURE_AND_SELECT
with type 'a t = 'a Functor.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Select.t

(** Incarnation of a [Selective] over a [Functor] using [branch] and [pure]. *)
module Over_functor_via_branch
(Functor : Preface_specs.Functor.CORE)
(Branch : Preface_specs.Selective.CORE_WITH_PURE_AND_BRANCH
with type 'a t = 'a Functor.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Branch.t

(** {2 Manual construction}

Advanced way to build an [Selective Functor], constructing and assembling a
Expand All @@ -34,20 +48,34 @@ module Via
(Syntax : Preface_specs.Selective.SYNTAX with type 'a t = 'a Core.t) :
Preface_specs.SELECTIVE with type 'a t = 'a Core.t

(** Incarnation of a [Selective.Core] over a [Functor]. *)
module Core_over_functor
(** Incarnation of a [Selective.Core] over a [Functor] via [select] and [pure]. *)
module Core_over_functor_via_select
(Functor : Preface_specs.Functor.CORE)
(Select : Preface_specs.Selective.CORE_WITH_PURE_AND_SELECT
with type 'a t = 'a Functor.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Functor.t

(** Incarnation of a [Selective.Core] over an [Applicative]. *)
module Core_over_applicative
(** Incarnation of a [Selective.Core] over a [Functor] via [branch] and [pure]. *)
module Core_over_functor_via_branch
(Functor : Preface_specs.Functor.CORE)
(Branch : Preface_specs.Selective.CORE_WITH_PURE_AND_BRANCH
with type 'a t = 'a Functor.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Functor.t

(** Incarnation of a [Selective.Core] over an [Applicative] using [select]. *)
module Core_over_applicative_via_select
(Applicative : Preface_specs.APPLICATIVE)
(Select : Preface_specs.Selective.CORE_WITH_SELECT
with type 'a t = 'a Applicative.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Applicative.t

(** Incarnation of a [Selective.Core] over an [Applicative] using [branch]. *)
module Core_over_applicative_via_branch
(Applicative : Preface_specs.APPLICATIVE)
(Branch : Preface_specs.Selective.CORE_WITH_BRANCH
with type 'a t = 'a Applicative.t) :
Preface_specs.Selective.CORE with type 'a t = 'a Applicative.t

(** Incarnation of [Selective.Operation] using [Selective.Core]. *)
module Operation (Core : Preface_specs.Selective.CORE) :
Preface_specs.Selective.OPERATION with type 'a t = 'a Core.t
Expand Down
26 changes: 22 additions & 4 deletions lib/preface_specs/selective.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@

(** {1 Structure anatomy} *)

(** Standard requirement with [select]. *)
module type CORE_WITH_SELECT = sig
type 'a t
(** The type held by the [Selective]. *)
Expand All @@ -13,17 +14,37 @@ module type CORE_WITH_SELECT = sig
[Right]. *)
end

(** Standard requirement with [branch]. *)
module type CORE_WITH_BRANCH = sig
type 'a t
(** The type held by the [Selective]. *)

val branch : ('a, 'b) Either.t t -> ('a -> 'c) t -> ('b -> 'c) t -> 'c t
(** [branch] is like [select]. It chooses between two effects. *)
end

(** Standard requirement including [pure] and [select]. *)
module type CORE_WITH_PURE_AND_SELECT = sig
include CORE_WITH_SELECT

val pure : 'a -> 'a t
(** Create a new ['a t]. *)
end

(** Standard requirement. *)
(** Standard requirement including [pure] and [branch]. *)
module type CORE_WITH_PURE_AND_BRANCH = sig
include CORE_WITH_BRANCH

val pure : 'a -> 'a t
(** Create a new ['a t]. *)
end

(** Standard requirement including Applicative requirements. *)
module type CORE = sig
include CORE_WITH_SELECT

include CORE_WITH_BRANCH with type 'a t := 'a t

include Applicative.CORE with type 'a t := 'a t
(** Each [Selective] is also an [Applicative]. *)
end
Expand All @@ -36,9 +57,6 @@ module type OPERATION = sig
include Applicative.OPERATION with type 'a t := 'a t
(** Each [Selective] is also an [Applicative]. *)

val branch : ('a, 'b) Either.t t -> ('a -> 'c) t -> ('b -> 'c) t -> 'c t
(** [branch] is like [select]. It chooses between two effects. *)

val if_ : bool t -> 'a t -> 'a t -> 'a t
(** Same of [branch] but using a [Boolean] as disjunction. *)

Expand Down
4 changes: 2 additions & 2 deletions lib/preface_stdlib/approximation.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module Over (M : Preface_specs.MONOID) = struct
end)

module Selective =
Preface_make.Selective.Over_applicative
Preface_make.Selective.Over_applicative_via_select
(Applicative)
(struct
type nonrec 'a t = 'a t
Expand All @@ -31,7 +31,7 @@ module Under (M : Preface_specs.MONOID) = struct
end)

module Selective =
Preface_make.Selective.Over_applicative
Preface_make.Selective.Over_applicative_via_select
(Applicative)
(struct
type nonrec 'a t = 'a t
Expand Down
2 changes: 1 addition & 1 deletion lib/preface_stdlib/identity.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ module Monad = Preface_make.Monad.Via_bind (struct
end)

module Selective =
Preface_make.Selective.Over_applicative
Preface_make.Selective.Over_applicative_via_select
(Applicative)
(Preface_make.Selective.Select_from_monad (Monad))

Expand Down
2 changes: 1 addition & 1 deletion lib/preface_stdlib/list.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ module Monad_traversable (M : Preface_specs.MONAD) =
module Monad =
Preface_make.Traversable.Join_with_monad (Monad_plus) (Monad_traversable)
module Selective =
Preface_make.Selective.Over_applicative
Preface_make.Selective.Over_applicative_via_select
(Applicative)
(Preface_make.Selective.Select_from_monad (Monad))

Expand Down
2 changes: 1 addition & 1 deletion lib/preface_stdlib/nonempty_list.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ module Monad_traversable (M : Preface_specs.MONAD) =
module Monad =
Preface_make.Traversable.Join_with_monad (Monad_internal) (Monad_traversable)
module Selective =
Preface_make.Selective.Over_applicative
Preface_make.Selective.Over_applicative_via_select
(Applicative)
(Preface_make.Selective.Select_from_monad (Monad))

Expand Down
2 changes: 1 addition & 1 deletion lib/preface_stdlib/validation.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,7 @@ module Selective (Errors : Preface_specs.SEMIGROUP) = struct
module A = Applicative (Errors)

module S =
Preface_make.Selective.Over_applicative
Preface_make.Selective.Over_applicative_via_select
(A)
(struct
type nonrec 'a t = ('a, Errors.t) t
Expand Down