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

Remove subsumption from Applicatives #569

Merged
merged 12 commits into from
Nov 26, 2023
Merged

Remove subsumption from Applicatives #569

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
ac46e9b
+ Failing test
gusty Nov 25, 2023
ee0f250
Use strict types for applicatives
gusty Nov 22, 2023
25baab4
Ambiguate keyValuePair
gusty Nov 22, 2023
029ed98
Tuple only input arguments
gusty Nov 22, 2023
d71abc6
Lower priority of problematic overloads
gusty Nov 22, 2023
bbb72b4
Lower them more
gusty Nov 22, 2023
64e91bd
Ambiguate KeyValuePair in Map
gusty Nov 23, 2023
bdfe1f2
Use DmStruct2
gusty Nov 24, 2023
6a3280b
Revert "Use DmStruct2"
gusty Nov 24, 2023
4f8ab5c
Use value tuples
gusty Nov 25, 2023
9474025
Align code
gusty Nov 25, 2023
c9944b0
Use Default2
gusty Nov 25, 2023
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
67 changes: 37 additions & 30 deletions src/FSharpPlus/Control/Applicative.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,57 +13,58 @@ open FSharpPlus.Data

type Apply =
inherit Default1

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

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)))
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)

static member ``<*>`` (f: Lazy<'T->'U> , x: Lazy<'T> , [<Optional>]_output: Lazy<'U> , [<Optional>]_mthd: Apply) = Lazy.apply f x : Lazy<'U>
static member ``<*>`` (f: seq<_> , x: seq<'T> , [<Optional>]_output: seq<'U> , [<Optional>]_mthd: Apply) = Seq.apply f x : seq<'U>
static member ``<*>`` (f: NonEmptySeq<_> , x: NonEmptySeq<'T> , [<Optional>]_output: NonEmptySeq<'U> , [<Optional>]_mthd: Apply) = NonEmptySeq.apply f x : NonEmptySeq<'U>
static member ``<*>`` (f: IEnumerator<_> , x: IEnumerator<'T> , [<Optional>]_output: IEnumerator<'U> , [<Optional>]_mthd: Apply) = Enumerator.map2 id f x : IEnumerator<'U>
static member ``<*>`` (f: list<_> , x: list<'T> , [<Optional>]_output: list<'U> , [<Optional>]_mthd: Apply) = List.apply f x : list<'U>
static member ``<*>`` (f: _ [] , x: 'T [] , [<Optional>]_output: 'U [] , [<Optional>]_mthd: Apply) = Array.apply f x : 'U []
static member ``<*>`` (f: 'r -> _ , g: _ -> 'T , [<Optional>]_output: 'r -> 'U , [<Optional>]_mthd: Apply) = fun x -> let f' = f x in f' (g x) : 'U
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
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)
static member ``<*>`` (struct (f: Lazy<'T->'U> , x: Lazy<'T> ) , _output: Lazy<'U> , [<Optional>]_mthd: Apply) = Lazy.apply f x : Lazy<'U>
static member ``<*>`` (struct (f: seq<_> , x: seq<'T> ) , _output: seq<'U> , [<Optional>]_mthd: Apply) = Seq.apply f x : seq<'U>
static member ``<*>`` (struct (f: NonEmptySeq<_> , x: NonEmptySeq<'T> ) , _output: NonEmptySeq<'U> , [<Optional>]_mthd: Apply) = NonEmptySeq.apply f x : NonEmptySeq<'U>
static member ``<*>`` (struct (f: IEnumerator<_> , x: IEnumerator<'T> ) , _output: IEnumerator<'U> , [<Optional>]_mthd: Apply) = Enumerator.map2 id f x : IEnumerator<'U>
static member ``<*>`` (struct (f: list<_> , x: list<'T> ) , _output: list<'U> , [<Optional>]_mthd: Apply) = List.apply f x : list<'U>
static member ``<*>`` (struct (f: _ [] , x: 'T [] ) , _output: 'U [] , [<Optional>]_mthd: Apply) = Array.apply f x : 'U []
static member ``<*>`` (struct (f: 'r -> _ , g: _ -> 'T ) , _output: 'r -> 'U , [<Optional>]_mthd: Apply) = fun x -> let f' = f x in f' (g x) : 'U
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
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)
#if !FABLE_COMPILER
static member ``<*>`` (f: Task<_> , x: Task<'T> , [<Optional>]_output: Task<'U> , [<Optional>]_mthd: Apply) = Task.apply f x : Task<'U>
static member ``<*>`` (struct (f: Task<_> , x: Task<'T> ), _output: Task<'U> , [<Optional>]_mthd: Apply) = Task.apply f x : Task<'U>
#endif
#if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER
static member ``<*>`` (f: ValueTask<_> , x: ValueTask<'T> , [<Optional>]_output: ValueTask<'U> , [<Optional>]_mthd: Apply) = ValueTask.apply f x : ValueTask<'U>
static member ``<*>`` (struct (f: ValueTask<_> , x: ValueTask<'T> ), _output: ValueTask<'U> , [<Optional>]_mthd: Default2) = ValueTask.apply f x : ValueTask<'U>
#endif
static member ``<*>`` (f: Async<_> , x: Async<'T> , [<Optional>]_output: Async<'U> , [<Optional>]_mthd: Apply) = Async.apply f x : Async<'U>
static member ``<*>`` (f: option<_> , x: option<'T> , [<Optional>]_output: option<'U> , [<Optional>]_mthd: Apply) = Option.apply f x : option<'U>
static member ``<*>`` (f: voption<_> , x: voption<'T> , [<Optional>]_output: voption<'U> , [<Optional>]_mthd: Apply) = ValueOption.apply f x : voption<'U>
static member ``<*>`` (f: Result<_,'E> , x: Result<'T,'E> , [<Optional>]_output: Result<'b,'E> , [<Optional>]_mthd: Apply) = Result.apply f x : Result<'U,'E>
static member ``<*>`` (f: Choice<_,'E> , x: Choice<'T,'E> , [<Optional>]_output: Choice<'b,'E> , [<Optional>]_mthd: Apply) = Choice.apply f x : Choice<'U,'E>
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)

static member ``<*>`` (f: Map<'Key,_> , x: Map<'Key,'T> , [<Optional>]_output: Map<'Key,'U> , [<Optional>]_mthd: Apply) : Map<'Key,'U> = Map (seq {
static member ``<*>`` (struct (f: Async<_> , x: Async<'T> ), _output: Async<'U> , [<Optional>]_mthd: Apply) = Async.apply f x : Async<'U>
static member ``<*>`` (struct (f: option<_> , x: option<'T> ), _output: option<'U> , [<Optional>]_mthd: Apply) = Option.apply f x : option<'U>
static member ``<*>`` (struct (f: voption<_> , x: voption<'T> ), _output: voption<'U> , [<Optional>]_mthd: Apply) = ValueOption.apply f x : voption<'U>
static member ``<*>`` (struct (f: Result<_,'E> , x: Result<'T,'E> ), _output: Result<'b,'E> , [<Optional>]_mthd: Apply) = Result.apply f x : Result<'U,'E>
static member ``<*>`` (struct (f: Choice<_,'E> , x: Choice<'T,'E> ), _output: Choice<'b,'E> , [<Optional>]_mthd: Apply) = Choice.apply f x : Choice<'U,'E>
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)
static member inline ``<*>`` (struct (f: KeyValuePair2<_,_>, x: KeyValuePair2<_,'T> ), _output: KeyValuePair2<_,'U> , [<Optional>]_mthd: Default2) : KeyValuePair2<'Key,'U> =
let a, b = f.Key, x.Key
let f, x = f.Value, x.Value
KeyValuePair2 (Plus.Invoke a b, f x)

static member ``<*>`` (struct (f: Map<'Key,_> , x: Map<'Key,'T> ) , _output: Map<'Key,'U> , [<Optional>]_mthd: Apply) : Map<'Key,'U> = Map (seq {
for KeyValue(k, vf) in f do
match Map.tryFind k x with
| Some vx -> yield k, vf vx
| _ -> () })

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

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

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

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

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


#endif

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

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

type Apply with
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)))
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

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)


type Lift2 =
inherit Default1

Expand Down
1 change: 1 addition & 0 deletions src/FSharpPlus/Control/Functor.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,6 +89,7 @@ type Map =
static member Map ((x: Result<_,'E> , f: 'T->'U), _mthd: Map) = Result.map f x
static member Map ((x: Choice<_,'E> , f: 'T->'U), _mthd: Map) = Choice.map f x
static member Map ((KeyValue(k, x) , f: 'T->'U), _mthd: Map) = KeyValuePair (k, f x)
static member Map ((x: KeyValuePair2<_, _> , f: 'T->'U), _mthd: Map) = let k, x = x.Key, x.Value in KeyValuePair2 (k, f x)
static member Map ((x: Map<'Key,'T> , f: 'T->'U), _mthd: Map) = Map.map (const' f) x : Map<'Key,'U>
static member Map ((x: Dictionary<_,_> , f: 'T->'U), _mthd: Map) = Dictionary.map f x : Dictionary<'Key,'U>
#if !FABLE_COMPILER
Expand Down
6 changes: 6 additions & 0 deletions src/FSharpPlus/Internals.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@
let inline tuple1<'t> (x: 't) =
#if FABLE_COMPILER
let t = ((),(),(),(),(),(),(),x)
t.Rest

Check warning on line 44 in src/FSharpPlus/Internals.fs

View workflow job for this annotation

GitHub Actions / testFable3SubsetOnCore 

This method or property is not normally used from F# code, use an explicit tuple pattern for deconstruction instead.
#else
System.Tuple<_> x
#endif
Expand Down Expand Up @@ -125,6 +125,12 @@

type DmStruct = struct end

type KeyValuePair2<'TKey, 'TValue> = struct
val Key : 'TKey
val Value : 'TValue
new (key, value) = { Key = key; Value = value }
end

[<Sealed>]
type Set2<'T when 'T: comparison >() = class end

Expand Down
19 changes: 19 additions & 0 deletions tests/FSharpPlus.Tests/General.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -220,6 +220,13 @@ type WrappedSeqE<'s> = WrappedSeqE of 's seq with
static member Reduce (WrappedSeqE x, reduction) = SideEffects.add "Using WrappedSeqE's Reduce"; Seq.reduce reduction x
static member ToSeq (WrappedSeqE x) = SideEffects.add "Using WrappedSeqE's ToSeq"; x

type WrappedSeqF<'s> = WrappedSeqF of 's seq with
interface Collections.Generic.IEnumerable<'s> with member x.GetEnumerator () = (let (WrappedSeqF x) = x in x).GetEnumerator ()
interface Collections.IEnumerable with member x.GetEnumerator () = (let (WrappedSeqF x) = x in x).GetEnumerator () :> Collections.IEnumerator
static member Return x = SideEffects.add "Using WrappedSeqF's Return"; WrappedSeqF (Seq.singleton x)
static member (<*>) (WrappedSeqF f, WrappedSeqF x) = SideEffects.add "Using WrappedSeqF's Apply"; WrappedSeqF (f <*> x)
static member ToList (WrappedSeqF x) = Seq.toList x

type TestNonEmptyCollection<'a> = private { Singleton: 'a } with
interface NonEmptySeq<'a> with
member this.First =
Expand Down Expand Up @@ -1205,6 +1212,18 @@ module Applicative =
Assert.AreEqual ([4;5;6], res456)
Assert.AreEqual (toList (run res9n5), toList (run' res9n5'))

// WrappedSeqC is Monad. Monads are Applicatives => (<*>) should work
let (res3: WrappedSeqC<_>) = WrappedSeqC [(+) 1] <*> WrappedSeqC [2]
CollectionAssert.AreEqual (WrappedSeqC [3], res3)

// Check user defined types implementing IEnumerable don't default to seq<_>
let res4 = WrappedSeqF [(+) 1] <*> WrappedSeqF [3]
Assert.IsInstanceOf<Option<WrappedSeqF<int>>> (Some res4)
CollectionAssert.AreEqual (WrappedSeqF [4], res4)
let res5 = WrappedSeqF [(+)] <*> WrappedSeqF [3] <*> WrappedSeqF [2]
Assert.IsInstanceOf<Option<WrappedSeqF<int>>> (Some res5)
CollectionAssert.AreEqual (WrappedSeqF [5], res5)

let testLift2 () =
let expectedEffects = ["Using WrappedSeqD's Return"; "Using WrappedSeqD's Apply"; "Using WrappedSeqD's Apply"]
SideEffects.reset ()
Expand Down
Loading