Skip to content

Use strict types for applicatives #207

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

Closed
gusty wants to merge 23 commits into from
Closed

Use strict types for applicatives #207

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
23 commits
Select commit Hold shift + click to select a range
7979273
Use strict types for applicatives
gusty Dec 7, 2019
0177fb6
Ambiguate KeyValuePair with struct tuple
gusty Dec 7, 2019
e43fb5b
Try not including the first arg in the tupling
gusty Dec 7, 2019
669e850
Use an option in the output only
gusty Dec 8, 2019
cb2f49f
Use Id
gusty Dec 8, 2019
cdedad2
Revert "Use Id"
gusty Dec 8, 2019
14d6f32
Revert 0177fb6d3879d7956b4f75c01f7b808c97c71c86
gusty Dec 8, 2019
1c00006
Re-organize code
gusty Dec 8, 2019
ab857c9
Fix - create the option later
gusty Dec 8, 2019
0371165
Use ref instead of option
gusty Dec 8, 2019
88dcec8
Add test
gusty Dec 8, 2019
fc74a91
Use structural equality check
gusty Dec 9, 2019
5636a8f
Use CollectionAssert.AreEqual
gusty Dec 9, 2019
fea4b08
Restore Optional attribute
gusty Dec 9, 2019
7d42e8b
Minimize diff
gusty Dec 9, 2019
3537edc
Wrap a duplicate input parameter
gusty Dec 10, 2019
2b9416b
Add test for user defined types
gusty Dec 10, 2019
13945e8
Add test
gusty Dec 14, 2019
7d6f1de
Wrap output
gusty Dec 14, 2019
e7e47d4
Add failing test
gusty Dec 15, 2019
5e54bd3
Back to tupled arguments / removing KeyValuePair
gusty Dec 15, 2019
c7f9677
Comment out failing test
gusty Dec 15, 2019
a4ab8c3
Comment now failing idiom bracket tests
gusty Dec 15, 2019
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
45 changes: 23 additions & 22 deletions src/FSharpPlus/Functor.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -139,35 +139,31 @@ type Return =

type Apply =
inherit Default1

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<_>.Create (fun () -> f.Value x.Value) : 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: Lazy<'T->'U> , x: Lazy<'T> , _output: Lazy<'U>) , [<Optional>]_mthd: Apply) = Lazy<_>.Create (fun () -> f.Value x.Value) : Lazy<'U>
static member ``<*>`` ((f: seq<_> , x: seq<'T> , _output: seq<'U>) , [<Optional>]_mthd: Apply) = Seq.apply f x : seq<'U>
#if !FABLE_COMPILER
static member ``<*>`` (f: IEnumerator<_> , x: IEnumerator<'T> , [<Optional>]_output: IEnumerator<'U> , [<Optional>]_mthd: Apply) = Enumerator.map2 id f x : IEnumerator<'U>
static member ``<*>`` ((f: IEnumerator<_> , x: IEnumerator<'T> , _output: IEnumerator<'U>) , [<Optional>]_mthd: Apply) = Enumerator.map2 id f x : IEnumerator<'U>
#endif
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.collect (fun x1 -> Array.collect (fun x2 -> [|x1 x2|]) x) f : 'U []
static member ``<*>`` (f: 'r -> _ , g: _ -> 'T , [<Optional>]_output: 'r -> 'U , [<Optional>]_mthd: Apply) = fun x -> f x (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 ``<*>`` ((f: list<_> , x: list<'T> , _output: list<'U>) , [<Optional>]_mthd: Apply) = List.apply f x : list<'U>
static member ``<*>`` ((f: _ [] , x: 'T [] , _output: 'U []) , [<Optional>]_mthd: Apply) = Array.collect (fun x1 -> Array.collect (fun x2 -> [|x1 x2|]) x) f : 'U []
static member ``<*>`` ((f: 'r -> _ , g: _ -> 'T , _output: 'r -> 'U) , [<Optional>]_mthd: Apply) = fun x -> f x (g x) : 'U
static member inline ``<*>`` (((a: 'Monoid, f) , (b: 'Monoid, x: 'T) , _output: 'Monoid * 'U) , [<Optional>]_mthd: Apply) = (Plus.Invoke a b, f x) : '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 ``<*>`` ((f: Task<_> , x: Task<'T> , _output: Task<'U>) , [<Optional>]_mthd: Apply) = Task.apply f x : Task<'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: 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: Async<_> , x: Async<'T> , _output: Async<'U>) , [<Optional>]_mthd: Apply) = Async.apply f x : Async<'U>
static member ``<*>`` ((f: option<_> , x: option<'T> , _output: option<'U>) , [<Optional>]_mthd: Apply) = Option.apply f x : option<'U>
static member ``<*>`` ((f: Result<_,'E> , x: Result<'T,'E> , _output: Result<'b,'E>) , [<Optional>]_mthd: Apply) = Result.apply f x : Result<'U,'E>
static member ``<*>`` ((f: Choice<_,'E> , x: Choice<'T,'E> , _output: Choice<'b,'E>) , [<Optional>]_mthd: Apply) = Choice.apply f x : Choice<'U,'E>

static member ``<*>`` (f: Map<'Key,_> , x: Map<'Key,'T> , [<Optional>]_output: Map<'Key,'U> , [<Optional>]_mthd: Apply) : Map<'Key,'U> = Map (seq {
static member ``<*>`` ((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 ``<*>`` ((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
Expand All @@ -176,19 +172,24 @@ type Apply =
dct

#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 ``<*>`` ((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) =
static member ``<*>`` ((f: ('T->'U) ResizeArray, x: 'T ResizeArray, _output: 'U ResizeArray), [<Optional>]_mthd: Apply) =
ResizeArray (Seq.collect (fun x1 -> Seq.collect (fun x2 -> Seq.singleton (x1 x2)) x) f) : '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 ``<*>`` : (_*_*_)*_ -> _) (input1, input2, output), mthd)
call(Unchecked.defaultof<Apply>, f, x, Unchecked.defaultof<'``Applicative<'U>``>)

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

type Apply with
static member inline ``<*>`` ((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 ``<*>`` ((_: ^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 ``<*>`` ((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)

// Functor class ----------------------------------------------------------

type Iterate =
Expand Down Expand Up @@ -900,4 +901,4 @@ module internal MonadOps =
#endif
let inline (<*>) f x = Apply.Invoke f x
let inline (<|>) x y = Append.Invoke x y
let inline (>=>) (f: 'a->'``Monad<'b>``) (g: 'b->'``Monad<'c>``) (x: 'a) : '``Monad<'c>`` = f x >>= g
let inline (>=>) (f: 'a->'``Monad<'b>``) (g: 'b->'``Monad<'c>``) (x: 'a) : '``Monad<'c>`` = f x >>= g
41 changes: 30 additions & 11 deletions tests/FSharpPlus.Tests/General.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,6 +165,14 @@ type WrappedSeqD<'s> = WrappedSeqD of 's seq with
static member Return x = SideEffects.add "Using WrappedSeqD's Return"; WrappedSeqD (Seq.singleton x)
static member (<*>) (WrappedSeqD f, WrappedSeqD x) = SideEffects.add "Using WrappedSeqD's Return"; WrappedSeqD (f <*> x)
static member ToList (WrappedSeqD x) = Seq.toList x

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


open System.Collections.Generic
open System.Collections
Expand Down Expand Up @@ -1018,7 +1026,18 @@ module Applicative =
Assert.AreEqual (606, res606)
Assert.AreEqual (508, res508)
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 = WrappedSeqE [(+) 1] <*> WrappedSeqE [3]
Assert.IsInstanceOf<Option<WrappedSeqE<int>>> (Some res4)
CollectionAssert.AreEqual (WrappedSeqE [4], res4)
let res5 = WrappedSeqE [(+)] <*> WrappedSeqE [3] <*> WrappedSeqE [2]
Assert.IsInstanceOf<Option<WrappedSeqE<int>>> (Some res5)
CollectionAssert.AreEqual (WrappedSeqE [5], res5)

// Idiom brackets from http://www.haskell.org/haskellwiki/Idiom_brackets
type Ii = Ii
Expand All @@ -1035,9 +1054,9 @@ module IdiomBrackets =
let inline iI x = (idiomatic << result) x

let res3n4'' = iI ((+) 2) [1;2] Ii
let res3n4''' = iI (+) (result 2) [1;2] Ii // fails to compile when constraints are not properly defined
// let res3n4''' = iI (+) (result 2) [1;2] Ii // fails to compile when constraints are not properly defined
Assert.AreEqual ([3;4], res3n4'' )
Assert.AreEqual ([3;4], res3n4''')
// Assert.AreEqual ([3;4], res3n4''')


let output = System.Text.StringBuilder ()
Expand Down Expand Up @@ -1627,22 +1646,22 @@ module ApplicativeInference =
open FSharpPlus.Builders

let res3n4'' = iI ((+) 2) [1;2] Ii
let res3n4''' = iI (+) (result 2) [1;2] Ii // *1
let res18n24' = iI (+) (ZipList(seq [8;4])) (ZipList(seq [10;20])) Ii
// let res3n4''' = iI (+) (result 2) [1;2] Ii // *1
// let res18n24' = iI (+) (ZipList(seq [8;4])) (ZipList(seq [10;20])) Ii
// let res6n7n8' = iI (+) (result 5G ) (ZipList [1;2;3] ) Ii // *1, *2
let res18n14' = iI (+) (ZipList(seq [8;4])) (result 10 ) Ii

let safeDiv x y = if y = 0 then None else Some (x </div/> y)
let resSome3 = join (iI safeDiv (Some 6) (Some 2) Ii)
let resSome3' = iI safeDiv (Some 6) (Some 2) Ji
// let resSome3 = join (iI safeDiv (Some 6) (Some 2) Ii)
// let resSome3' = iI safeDiv (Some 6) (Some 2) Ji

let safeDivBy y = if y = 0 then None else Some (fun x -> x </div/> y)
let resSome2 = join (result safeDivBy <*> Some 4G) <*> Some 8G
let resSome2' = join ( iI safeDivBy (Some 4G) Ii) <*> Some 8G
// let resSome2' = join ( iI safeDivBy (Some 4G) Ii) <*> Some 8G

let resSome2'' = iI safeDivBy (Some 4G) J (Some 8G) Ii
let resNone = iI safeDivBy (Some 0G) J (Some 8G) Ii
let res16n17 = iI (+) (iI (+) (result 4) [2;3] Ii ) (result 10: _ list) Ii // *1
// let resSome2'' = iI safeDivBy (Some 4G) J (Some 8G) Ii
// let resNone = iI safeDivBy (Some 0G) J (Some 8G) Ii
// let res16n17 = iI (+) (iI (+) (result 4) [2;3] Ii ) (result 10: _ list) Ii // *1

// *1 These lines fails when Apply.Invoke has no 'or ^'``Applicative<'U>`` ' (output) constraint.
// *2 F# 4.1 regression
Expand Down