Skip to content

Commit 52fa7b7

Browse files
gustygusty
authored
Remove subsumption from Applicatives (#569)
1 parent b1ed24b commit 52fa7b7

File tree

4 files changed

+63
-30
lines changed

4 files changed

+63
-30
lines changed

‎src/FSharpPlus/Control/Applicative.fs

+37-30
Original file line numberDiff line numberDiff line change
@@ -13,57 +13,58 @@ open FSharpPlus.Data
1313

1414
type Apply =
1515
inherit Default1
16-
16+
1717
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
1818

19-
static member inline ``<*>`` (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` , [<Optional>]_output: '``Monad<'U>`` , [<Optional>]_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> Return.InvokeOnInstance (x1 x2)))
20-
static member inline ``<*>`` (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``, [<Optional>]_output: '``Applicative<'U>``, [<Optional>]_mthd:Default1) : '``Applicative<'U>`` = ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<*>) : _*_ -> _) f, x)
21-
22-
static member ``<*>`` (f: Lazy<'T->'U> , x: Lazy<'T> , [<Optional>]_output: Lazy<'U> , [<Optional>]_mthd: Apply) = Lazy.apply f x : Lazy<'U>
23-
static member ``<*>`` (f: seq<_> , x: seq<'T> , [<Optional>]_output: seq<'U> , [<Optional>]_mthd: Apply) = Seq.apply f x : seq<'U>
24-
static member ``<*>`` (f: NonEmptySeq<_> , x: NonEmptySeq<'T> , [<Optional>]_output: NonEmptySeq<'U> , [<Optional>]_mthd: Apply) = NonEmptySeq.apply f x : NonEmptySeq<'U>
25-
static member ``<*>`` (f: IEnumerator<_> , x: IEnumerator<'T> , [<Optional>]_output: IEnumerator<'U> , [<Optional>]_mthd: Apply) = Enumerator.map2 id f x : IEnumerator<'U>
26-
static member ``<*>`` (f: list<_> , x: list<'T> , [<Optional>]_output: list<'U> , [<Optional>]_mthd: Apply) = List.apply f x : list<'U>
27-
static member ``<*>`` (f: _ [] , x: 'T [] , [<Optional>]_output: 'U [] , [<Optional>]_mthd: Apply) = Array.apply f x : 'U []
28-
static member ``<*>`` (f: 'r -> _ , g: _ -> 'T , [<Optional>]_output: 'r -> 'U , [<Optional>]_mthd: Apply) = fun x -> let f' = f x in f' (g x) : 'U
29-
static member inline ``<*>`` ((a: 'Monoid, f) , (b: 'Monoid, x: 'T) , [<Optional>]_output: 'Monoid * 'U , [<Optional>]_mthd: Apply) = (Plus.Invoke a b, f x) : 'Monoid *'U
30-
static member inline ``<*>`` (struct (a: 'Monoid, f), struct (b: 'Monoid, x: 'T), [<Optional>]_output: struct ('Monoid * 'U), [<Optional>]_mthd: Apply) = struct (Plus.Invoke a b, f x) : struct ('Monoid * 'U)
19+
static member ``<*>`` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ) , _output: Lazy<'U> , [<Optional>]_mthd: Apply) = Lazy.apply f x : Lazy<'U>
20+
static member ``<*>`` (struct (f: seq<_> , x: seq<'T> ) , _output: seq<'U> , [<Optional>]_mthd: Apply) = Seq.apply f x : seq<'U>
21+
static member ``<*>`` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ) , _output: NonEmptySeq<'U> , [<Optional>]_mthd: Apply) = NonEmptySeq.apply f x : NonEmptySeq<'U>
22+
static member ``<*>`` (struct (f: IEnumerator<_> , x: IEnumerator<'T> ) , _output: IEnumerator<'U> , [<Optional>]_mthd: Apply) = Enumerator.map2 id f x : IEnumerator<'U>
23+
static member ``<*>`` (struct (f: list<_> , x: list<'T> ) , _output: list<'U> , [<Optional>]_mthd: Apply) = List.apply f x : list<'U>
24+
static member ``<*>`` (struct (f: _ [] , x: 'T [] ) , _output: 'U [] , [<Optional>]_mthd: Apply) = Array.apply f x : 'U []
25+
static member ``<*>`` (struct (f: 'r -> _ , g: _ -> 'T ) , _output: 'r -> 'U , [<Optional>]_mthd: Apply) = fun x -> let f' = f x in f' (g x) : 'U
26+
static member inline ``<*>`` (struct ((a: 'Monoid, f) , (b: 'Monoid, x: 'T) ) , _output: 'Monoid * 'U , [<Optional>]_mthd: Apply) = (Plus.Invoke a b, f x) : 'Monoid *'U
27+
static member inline ``<*>`` (struct (struct (a: 'Monoid, f), struct (b: 'Monoid, x: 'T)), _output: struct ('Monoid * 'U), [<Optional>]_mthd: Apply) = struct (Plus.Invoke a b, f x) : struct ('Monoid * 'U)
3128
#if !FABLE_COMPILER
32-
static member ``<*>`` (f: Task<_> , x: Task<'T> , [<Optional>]_output: Task<'U> , [<Optional>]_mthd: Apply) = Task.apply f x : Task<'U>
29+
static member ``<*>`` (struct (f: Task<_> , x: Task<'T> ), _output: Task<'U> , [<Optional>]_mthd: Apply) = Task.apply f x : Task<'U>
3330
#endif
3431
#if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER
35-
static member ``<*>`` (f: ValueTask<_> , x: ValueTask<'T> , [<Optional>]_output: ValueTask<'U> , [<Optional>]_mthd: Apply) = ValueTask.apply f x : ValueTask<'U>
32+
static member ``<*>`` (struct (f: ValueTask<_> , x: ValueTask<'T> ), _output: ValueTask<'U> , [<Optional>]_mthd: Default2) = ValueTask.apply f x : ValueTask<'U>
3633
#endif
37-
static member ``<*>`` (f: Async<_> , x: Async<'T> , [<Optional>]_output: Async<'U> , [<Optional>]_mthd: Apply) = Async.apply f x : Async<'U>
38-
static member ``<*>`` (f: option<_> , x: option<'T> , [<Optional>]_output: option<'U> , [<Optional>]_mthd: Apply) = Option.apply f x : option<'U>
39-
static member ``<*>`` (f: voption<_> , x: voption<'T> , [<Optional>]_output: voption<'U> , [<Optional>]_mthd: Apply) = ValueOption.apply f x : voption<'U>
40-
static member ``<*>`` (f: Result<_,'E> , x: Result<'T,'E> , [<Optional>]_output: Result<'b,'E> , [<Optional>]_mthd: Apply) = Result.apply f x : Result<'U,'E>
41-
static member ``<*>`` (f: Choice<_,'E> , x: Choice<'T,'E> , [<Optional>]_output: Choice<'b,'E> , [<Optional>]_mthd: Apply) = Choice.apply f x : Choice<'U,'E>
42-
static member inline ``<*>`` (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T), [<Optional>]_output: KeyValuePair<'Key,'U>, [<Optional>]_mthd: Apply) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x)
43-
44-
static member ``<*>`` (f: Map<'Key,_> , x: Map<'Key,'T> , [<Optional>]_output: Map<'Key,'U> , [<Optional>]_mthd: Apply) : Map<'Key,'U> = Map (seq {
34+
static member ``<*>`` (struct (f: Async<_> , x: Async<'T> ), _output: Async<'U> , [<Optional>]_mthd: Apply) = Async.apply f x : Async<'U>
35+
static member ``<*>`` (struct (f: option<_> , x: option<'T> ), _output: option<'U> , [<Optional>]_mthd: Apply) = Option.apply f x : option<'U>
36+
static member ``<*>`` (struct (f: voption<_> , x: voption<'T> ), _output: voption<'U> , [<Optional>]_mthd: Apply) = ValueOption.apply f x : voption<'U>
37+
static member ``<*>`` (struct (f: Result<_,'E> , x: Result<'T,'E> ), _output: Result<'b,'E> , [<Optional>]_mthd: Apply) = Result.apply f x : Result<'U,'E>
38+
static member ``<*>`` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), _output: Choice<'b,'E> , [<Optional>]_mthd: Apply) = Choice.apply f x : Choice<'U,'E>
39+
static member inline ``<*>`` (struct (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T)), _output: KeyValuePair<'Key,'U>, [<Optional>]_mthd: Default2) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x)
40+
static member inline ``<*>`` (struct (f: KeyValuePair2<_,_>, x: KeyValuePair2<_,'T> ), _output: KeyValuePair2<_,'U> , [<Optional>]_mthd: Default2) : KeyValuePair2<'Key,'U> =
41+
let a, b = f.Key, x.Key
42+
let f, x = f.Value, x.Value
43+
KeyValuePair2 (Plus.Invoke a b, f x)
44+
45+
static member ``<*>`` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ) , _output: Map<'Key,'U> , [<Optional>]_mthd: Apply) : Map<'Key,'U> = Map (seq {
4546
for KeyValue(k, vf) in f do
4647
match Map.tryFind k x with
4748
| Some vx -> yield k, vf vx
4849
| _ -> () })
4950

50-
static member ``<*>`` (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T> , [<Optional>]_output: Dictionary<'Key,'U> , [<Optional>]_mthd: Apply) : Dictionary<'Key,'U> =
51+
static member ``<*>`` (struct (f: Dictionary<'Key,_>, x: Dictionary<'Key,'T>) , _output: Dictionary<'Key,'U> , [<Optional>]_mthd: Apply) : Dictionary<'Key,'U> =
5152
let dct = Dictionary ()
5253
for KeyValue(k, vf) in f do
5354
match x.TryGetValue k with
5455
| true, vx -> dct.Add (k, vf vx)
5556
| _ -> ()
5657
dct
5758

58-
static member ``<*>`` (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T> , [<Optional>]_output: IDictionary<'Key,'U> , [<Optional>]_mthd: Apply) : IDictionary<'Key,'U> =
59+
static member ``<*>`` (struct (f: IDictionary<'Key,_>, x: IDictionary<'Key,'T>) , _output: IDictionary<'Key,'U> , [<Optional>]_mthd: Apply) : IDictionary<'Key,'U> =
5960
let dct = Dictionary ()
6061
for KeyValue(k, vf) in f do
6162
match x.TryGetValue k with
6263
| true, vx -> dct.Add (k, vf vx)
6364
| _ -> ()
6465
dct :> IDictionary<'Key,'U>
6566

66-
static member ``<*>`` (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T> , [<Optional>]_output: IReadOnlyDictionary<'Key,'U> , [<Optional>]_mthd: Apply) : IReadOnlyDictionary<'Key,'U> =
67+
static member ``<*>`` (struct (f: IReadOnlyDictionary<'Key,_>, x: IReadOnlyDictionary<'Key,'T>) , _output: IReadOnlyDictionary<'Key,'U> , [<Optional>]_mthd: Apply) : IReadOnlyDictionary<'Key,'U> =
6768
let dct = Dictionary ()
6869
for KeyValue(k, vf) in f do
6970
match x.TryGetValue k with
@@ -72,23 +73,29 @@ type Apply =
7273
dct :> IReadOnlyDictionary<'Key,'U>
7374

7475
#if !FABLE_COMPILER
75-
static member ``<*>`` (f: Expr<'T->'U>, x: Expr<'T>, [<Optional>]_output: Expr<'U>, [<Optional>]_mthd: Apply) = Expr.Cast<'U> (Expr.Application (f, x))
76+
static member ``<*>`` (struct (f: Expr<'T->'U>, x: Expr<'T>), _output: Expr<'U>, [<Optional>]_mthd: Apply) = Expr.Cast<'U> (Expr.Application (f, x))
7677
#endif
77-
static member ``<*>`` (f: ('T->'U) ResizeArray, x: 'T ResizeArray, [<Optional>]_output: 'U ResizeArray, [<Optional>]_mthd: Apply) = ResizeArray.apply f x : 'U ResizeArray
78+
static member ``<*>`` (struct (f: ('T->'U) ResizeArray, x: 'T ResizeArray), _output: 'U ResizeArray, [<Optional>]_mthd: Apply) = ResizeArray.apply f x : 'U ResizeArray
7879

7980
static member inline Invoke (f: '``Applicative<'T -> 'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` =
8081
let inline call (mthd : ^M, input1: ^I1, input2: ^I2, output: ^R) =
81-
((^M or ^I1 or ^I2 or ^R) : (static member ``<*>`` : _*_*_*_ -> _) input1, input2, output, mthd)
82+
((^M or ^I1 or ^I2 or ^R) : (static member ``<*>`` : struct (_*_) * _ * _ -> _) (struct (input1, input2)), output, mthd)
8283
call(Unchecked.defaultof<Apply>, f, x, Unchecked.defaultof<'``Applicative<'U>``>)
8384

84-
8585
#endif
8686

8787
static member inline InvokeOnInstance (f: '``Applicative<'T->'U>``) (x: '``Applicative<'T>``) : '``Applicative<'U>`` =
8888
((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<*>) : _*_ -> _) (f, x))
8989

9090
#if (!FABLE_COMPILER || FABLE_COMPILER_3) && !FABLE_COMPILER_4
9191

92+
type Apply with
93+
static member inline ``<*>`` (struct (f: '``Monad<'T->'U>`` , x: '``Monad<'T>`` ) , _output: '``Monad<'U>`` , [<Optional>]_mthd:Default2) : '``Monad<'U>`` = Bind.InvokeOnInstance f (fun (x1: 'T->'U) -> Bind.InvokeOnInstance x (fun x2 -> Return.InvokeOnInstance (x1 x2)))
94+
static member inline ``<*>`` (struct (_: ^t when ^t : null and ^t: struct, _: ^u when ^u : null and ^u: struct), _output: ^r when ^r : null and ^r: struct, _mthd: Default1) = id
95+
96+
static member inline ``<*>`` (struct (f: '``Applicative<'T->'U>``, x: '``Applicative<'T>``), _output: '``Applicative<'U>``, [<Optional>]_mthd: Default1) : '``Applicative<'U>`` = ((^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<*>) : _*_ -> _) f, x)
97+
98+
9299
type Lift2 =
93100
inherit Default1
94101

‎src/FSharpPlus/Control/Functor.fs

+1
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,7 @@ type Map =
8989
static member Map ((x: Result<_,'E> , f: 'T->'U), _mthd: Map) = Result.map f x
9090
static member Map ((x: Choice<_,'E> , f: 'T->'U), _mthd: Map) = Choice.map f x
9191
static member Map ((KeyValue(k, x) , f: 'T->'U), _mthd: Map) = KeyValuePair (k, f x)
92+
static member Map ((x: KeyValuePair2<_, _> , f: 'T->'U), _mthd: Map) = let k, x = x.Key, x.Value in KeyValuePair2 (k, f x)
9293
static member Map ((x: Map<'Key,'T> , f: 'T->'U), _mthd: Map) = Map.map (const' f) x : Map<'Key,'U>
9394
static member Map ((x: Dictionary<_,_> , f: 'T->'U), _mthd: Map) = Dictionary.map f x : Dictionary<'Key,'U>
9495
#if !FABLE_COMPILER

‎src/FSharpPlus/Internals.fs

+6
Original file line numberDiff line numberDiff line change
@@ -125,6 +125,12 @@ type Either<'t,'u> =
125125

126126
type DmStruct = struct end
127127

128+
type KeyValuePair2<'TKey, 'TValue> = struct
129+
val Key : 'TKey
130+
val Value : 'TValue
131+
new (key, value) = { Key = key; Value = value }
132+
end
133+
128134
[<Sealed>]
129135
type Set2<'T when 'T: comparison >() = class end
130136

‎tests/FSharpPlus.Tests/General.fs

+19
Original file line numberDiff line numberDiff line change
@@ -220,6 +220,13 @@ type WrappedSeqE<'s> = WrappedSeqE of 's seq with
220220
static member Reduce (WrappedSeqE x, reduction) = SideEffects.add "Using WrappedSeqE's Reduce"; Seq.reduce reduction x
221221
static member ToSeq (WrappedSeqE x) = SideEffects.add "Using WrappedSeqE's ToSeq"; x
222222

223+
type WrappedSeqF<'s> = WrappedSeqF of 's seq with
224+
interface Collections.Generic.IEnumerable<'s> with member x.GetEnumerator () = (let (WrappedSeqF x) = x in x).GetEnumerator ()
225+
interface Collections.IEnumerable with member x.GetEnumerator () = (let (WrappedSeqF x) = x in x).GetEnumerator () :> Collections.IEnumerator
226+
static member Return x = SideEffects.add "Using WrappedSeqF's Return"; WrappedSeqF (Seq.singleton x)
227+
static member (<*>) (WrappedSeqF f, WrappedSeqF x) = SideEffects.add "Using WrappedSeqF's Apply"; WrappedSeqF (f <*> x)
228+
static member ToList (WrappedSeqF x) = Seq.toList x
229+
223230
type TestNonEmptyCollection<'a> = private { Singleton: 'a } with
224231
interface NonEmptySeq<'a> with
225232
member this.First =
@@ -1205,6 +1212,18 @@ module Applicative =
12051212
Assert.AreEqual ([4;5;6], res456)
12061213
Assert.AreEqual (toList (run res9n5), toList (run' res9n5'))
12071214

1215+
// WrappedSeqC is Monad. Monads are Applicatives => (<*>) should work
1216+
let (res3: WrappedSeqC<_>) = WrappedSeqC [(+) 1] <*> WrappedSeqC [2]
1217+
CollectionAssert.AreEqual (WrappedSeqC [3], res3)
1218+
1219+
// Check user defined types implementing IEnumerable don't default to seq<_>
1220+
let res4 = WrappedSeqF [(+) 1] <*> WrappedSeqF [3]
1221+
Assert.IsInstanceOf<Option<WrappedSeqF<int>>> (Some res4)
1222+
CollectionAssert.AreEqual (WrappedSeqF [4], res4)
1223+
let res5 = WrappedSeqF [(+)] <*> WrappedSeqF [3] <*> WrappedSeqF [2]
1224+
Assert.IsInstanceOf<Option<WrappedSeqF<int>>> (Some res5)
1225+
CollectionAssert.AreEqual (WrappedSeqF [5], res5)
1226+
12081227
let testLift2 () =
12091228
let expectedEffects = ["Using WrappedSeqD's Return"; "Using WrappedSeqD's Apply"; "Using WrappedSeqD's Apply"]
12101229
SideEffects.reset ()

0 commit comments

Comments
 (0)