diff --git a/README.md b/README.md index 5a7f80e6b..dfd06da59 100644 --- a/README.md +++ b/README.md @@ -32,8 +32,7 @@ Please do join us to chat on: - Gitter [![Join the chat at https://gitter.im/fsprojects/FSharpPlus](https://badges.gitter.im/fsprojects/FSharpPlus.svg)](https://gitter.im/fsprojects/FSharpPlus?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) -- [#FSharpPlus on Functional programming Slack](https://app.slack.com/client/T0432GV8P/CTT70ER47) - If you need to request an invitation head to https://fpchat-invite.herokuapp.com/ to get one. +- You can get invited into the [functional programming Slack](https://app.slack.com/client/T0432GV8P/CTT70ER47) and then join [#FSharpPlus](https://functionalprogramming.slack.com/join/shared_invite/zt-svowkzcg-6xzAuVrUtINX7swWuhjHUw#/shared-invite/email) ...or you can [ask a question on stack overflow](https://stackoverflow.com/questions/ask?tags=f%23%2b) with tag `F#+` diff --git a/build.proj b/build.proj index 2f1f16eee..a3e35ed69 100644 --- a/build.proj +++ b/build.proj @@ -15,7 +15,7 @@ - + diff --git a/docsrc/content/extensions.fsx b/docsrc/content/extensions.fsx index fa296b91b..d1ad0980a 100644 --- a/docsrc/content/extensions.fsx +++ b/docsrc/content/extensions.fsx @@ -262,10 +262,11 @@ Collections / Traversable types: Async and Tasks: ================ * [ Task ](reference/fsharpplus-task.html) - * map, map2 + * map, map2, map3 * apply * zip * join + * ignore * [ Async ](reference/fsharpplus-async.html) * map, map2 * zip diff --git a/docsrc/content/tutorial.fsx b/docsrc/content/tutorial.fsx index 8a7f3ce07..0a14cb579 100644 --- a/docsrc/content/tutorial.fsx +++ b/docsrc/content/tutorial.fsx @@ -2,7 +2,8 @@ // This block of code is omitted in the generated HTML documentation. Use // it to define helpers that you do not want to show in the documentation. -#r @"../../src/FSharpPlus/bin/Release/net45/FSharpPlus.dll" +#r @"../../src/FSharpPlus/bin/Release/netstandard2.0/FSharpPlus.dll" +#nowarn "0058" // We need to cheat a bit with indentation here. (** Introducing FSharpPlus diff --git a/docsrc/tools/docsTool.fsproj b/docsrc/tools/docsTool.fsproj index 6e9689047..f623d1a06 100644 --- a/docsrc/tools/docsTool.fsproj +++ b/docsrc/tools/docsTool.fsproj @@ -2,7 +2,7 @@ Exe - net5 + net6.0 diff --git a/src/FSharpPlus.Docs/FSharpPlus.Docs.fsproj b/src/FSharpPlus.Docs/FSharpPlus.Docs.fsproj index fa558b95c..c45155712 100644 --- a/src/FSharpPlus.Docs/FSharpPlus.Docs.fsproj +++ b/src/FSharpPlus.Docs/FSharpPlus.Docs.fsproj @@ -54,7 +54,7 @@ - + diff --git a/src/FSharpPlus.TypeLevel/FSharpPlus.TypeLevel.fsproj b/src/FSharpPlus.TypeLevel/FSharpPlus.TypeLevel.fsproj index c4efb1a14..9bd80100d 100644 --- a/src/FSharpPlus.TypeLevel/FSharpPlus.TypeLevel.fsproj +++ b/src/FSharpPlus.TypeLevel/FSharpPlus.TypeLevel.fsproj @@ -23,7 +23,8 @@ --> - + + diff --git a/src/FSharpPlus.TypeLevel/Providers/FSharpPlus.Providers.fsproj b/src/FSharpPlus.TypeLevel/Providers/FSharpPlus.Providers.fsproj index 26a01862a..361b1abca 100644 --- a/src/FSharpPlus.TypeLevel/Providers/FSharpPlus.Providers.fsproj +++ b/src/FSharpPlus.TypeLevel/Providers/FSharpPlus.Providers.fsproj @@ -41,7 +41,8 @@ - + + diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 96b2c6a6c..d33855bae 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -122,59 +122,92 @@ module GenericBuilders = open FSharpPlus.Control type Builder<'``monad<'t>``> () = - member __.ReturnFrom (expr) = expr : '``monad<'t>`` - member inline __.Return (x: 'T) = result x : '``Monad<'T>`` - member inline __.Yield (x: 'T) = result x : '``Monad<'T>`` - member inline __.Bind (p: '``Monad<'T>``, rest: 'T->'``Monad<'U>``) = p >>= rest : '``Monad<'U>`` - member inline __.MergeSources (t1: '``Monad<'T>``, t2: '``Monad<'U>``) : '``Monad<'T * 'U>`` = Lift2.Invoke tuple2 t1 t2 - member inline __.MergeSources3 (t1: '``Monad<'T>``, t2: '``Monad<'U>``, t3: '``Monad<'V>``) : '``Monad<'T * 'U * 'V>`` = Lift3.Invoke tuple3 t1 t2 t3 + member _.ReturnFrom (expr) = expr : '``monad<'t>`` + member inline _.Return (x: 'T) = result x : '``Monad<'T>`` + member inline _.Yield (x: 'T) = result x : '``Monad<'T>`` + #if !NET45 + member inline _.Bind (p: '``Monad<'T>``, []rest: 'T->'``Monad<'U>``) = p >>= rest : '``Monad<'U>`` + #else + member inline _.Bind (p: '``Monad<'T>``, rest: 'T->'``Monad<'U>``) = p >>= rest : '``Monad<'U>`` + #endif + member inline _.MergeSources (t1: '``Monad<'T>``, t2: '``Monad<'U>``) : '``Monad<'T * 'U>`` = Lift2.Invoke tuple2 t1 t2 + member inline _.MergeSources3 (t1: '``Monad<'T>``, t2: '``Monad<'U>``, t3: '``Monad<'V>``) : '``Monad<'T * 'U * 'V>`` = Lift3.Invoke tuple3 t1 t2 t3 [] - member inline __.Select (x, [] f) = map f x + member inline _.Select (x, [] f) = map f x [] - member inline __.Where (x, [] p) = mfilter p x + member inline _.Where (x, [] p) = mfilter p x [] - member inline __.Top (source, n) = limit n source + member inline _.Top (source, n) = limit n source [] - member inline __.GroupBy (x,[] f : 'T -> 'key) = groupBy f x + member inline _.GroupBy (x,[] f : 'T -> 'key) = groupBy f x [] - member inline __.ChunkBy (x,[] f : 'T -> 'key) = chunkBy f x + member inline _.ChunkBy (x,[] f : 'T -> 'key) = chunkBy f x [] - member inline __.OrderBy (x,[] f : 'T -> 'key) = sortBy f x + member inline _.OrderBy (x,[] f : 'T -> 'key) = sortBy f x type StrictBuilder<'``monad<'t>``> () = inherit Builder<'``monad<'t>``> () - member __.Delay expr = expr : unit -> '``Monad<'T>`` - member __.Run f = f () : '``monad<'t>`` - member inline __.TryWith (expr, handler) = TryWith.InvokeForStrict expr handler : '``Monad<'T>`` - member inline __.TryFinally (expr, compensation) = TryFinally.InvokeForStrict expr compensation : '``Monad<'T>`` + #if !NET45 + member inline _.Delay ([]expr) = expr : unit -> '``Monad<'T>`` + member inline _.Run ([]f) = f () : '``monad<'t>`` + member inline _.TryWith ([]expr, []handler) = TryWith.InvokeForStrict expr handler : '``Monad<'T>`` + member inline _.TryFinally ([]expr, []compensation) = TryFinally.InvokeForStrict expr compensation : '``Monad<'T>`` - member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body + member inline _.Using (disposable: #IDisposable, []body) = Using.Invoke disposable body + #else + member inline _.Delay (expr) = expr : unit -> '``Monad<'T>`` + member inline _.Run (f) = f () : '``monad<'t>`` + member inline _.TryWith (expr, handler) = TryWith.InvokeForStrict expr handler : '``Monad<'T>`` + member inline _.TryFinally (expr, compensation) = TryFinally.InvokeForStrict expr compensation : '``Monad<'T>`` + + member inline _.Using (disposable: #IDisposable, body) = Using.Invoke disposable body + #endif type DelayedBuilder<'``monad<'t>``> () = inherit Builder<'``monad<'t>``> () - member inline __.Delay (expr: _->'``Monad<'T>``) = Delay.Invoke expr : '``Monad<'T>`` - member __.Run f = f : '``monad<'t>`` - member inline __.TryWith (expr, handler ) = TryWith.Invoke expr handler : '``Monad<'T>`` - member inline __.TryFinally (expr, compensation) = TryFinally.Invoke expr compensation : '``Monad<'T>`` - member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body : '``Monad<'T>`` + #if !NET45 + member inline _.Delay ([]expr: _->'``Monad<'T>``) = Delay.Invoke expr : '``Monad<'T>`` + member _.Run f = f : '``monad<'t>`` + member inline _.TryWith (expr, []handler ) = TryWith.Invoke expr handler : '``Monad<'T>`` + member inline _.TryFinally (expr, []compensation) = TryFinally.Invoke expr compensation : '``Monad<'T>`` + member inline _.Using (disposable: #IDisposable, []body) = Using.Invoke disposable body : '``Monad<'T>`` + #else + member inline _.Delay (expr: _->'``Monad<'T>``) = Delay.Invoke expr : '``Monad<'T>`` + member _.Run f = f : '``monad<'t>`` + member inline _.TryWith (expr, handler ) = TryWith.Invoke expr handler : '``Monad<'T>`` + member inline _.TryFinally (expr, compensation) = TryFinally.Invoke expr compensation : '``Monad<'T>`` + member inline _.Using (disposable: #IDisposable, body) = Using.Invoke disposable body : '``Monad<'T>`` + #endif type MonadPlusStrictBuilder<'``monad<'t>``> () = inherit StrictBuilder<'``monad<'t>``> () - member __.YieldFrom expr = expr : '``monad<'t>`` - member inline __.Zero () = Empty.Invoke () : '``MonadPlus<'T>`` - member inline __.Combine (a: '``MonadPlus<'T>``, b) = a <|> b () : '``MonadPlus<'T>`` - member inline __.While (guard, body: unit -> '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + member _.YieldFrom expr = expr : '``monad<'t>`` + member inline _.Zero () = Empty.Invoke () : '``MonadPlus<'T>`` + #if !NET45 + member inline _.Combine (a: '``MonadPlus<'T>``, []b) = a <|> b () : '``MonadPlus<'T>`` + #else + member inline _.Combine (a: '``MonadPlus<'T>``, b) = a <|> b () : '``MonadPlus<'T>`` + #endif + #if !NET45 + member inline _.While ([]guard, []body: unit -> '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + #else + member inline _.While (guard, body: unit -> '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + #endif let rec loop guard body = if guard () then body () <|> loop guard body else Empty.Invoke () loop guard body + #if !NET45 + member inline this.For (p: #seq<'T>, []rest: 'T->'``MonadPlus<'U>``) = + #else member inline this.For (p: #seq<'T>, rest: 'T->'``MonadPlus<'U>``) = + #endif Using.Invoke (p.GetEnumerator () :> IDisposable) (fun enum -> let enum = enum :?> IEnumerator<_> this.While (enum.MoveNext, fun () -> rest enum.Current) : '``MonadPlus<'U>``) @@ -182,37 +215,61 @@ module GenericBuilders = type MonadFxStrictBuilder<'``monad<'t>``> () = inherit StrictBuilder<'``monad<'t>``> () - member inline __.Zero () = result () : '``Monad`` - member inline __.Combine (a: '``Monad``, b) = a >>= (fun () -> b ()) : '``Monad<'T>`` + member inline _.Zero () = result () : '``Monad`` + #if !NET45 + member inline _.Combine (a: '``Monad``, []b) = a >>= (fun () -> b ()) : '``Monad<'T>`` + #else + member inline _.Combine (a: '``Monad``, b) = a >>= (fun () -> b ()) : '``Monad<'T>`` + #endif - member inline __.While (guard, body: unit -> '``Monad``) : '``Monad`` = + #if !NET45 + member inline _.While ([]guard, []body: unit -> '``Monad``) : '``Monad`` = + #else + member inline _.While (guard, body: unit -> '``Monad``) : '``Monad`` = + #endif let rec loop guard body = if guard () then body () >>= fun () -> loop guard body else result () loop guard body + #if !NET45 + member inline this.For (p: #seq<'T>, []rest: 'T->'``Monad``) = + #else member inline this.For (p: #seq<'T>, rest: 'T->'``Monad``) = + #endif Using.Invoke (p.GetEnumerator () :> IDisposable) (fun enum -> let enum = enum :?> IEnumerator<_> this.While (enum.MoveNext, fun () -> rest enum.Current) : '``Monad``) type MonadPlusBuilder<'``monad<'t>``> () = inherit DelayedBuilder<'``monad<'t>``>() - member __.YieldFrom expr = expr : '``monad<'t>`` - member __.strict = new MonadPlusStrictBuilder<'``monad<'t>``> () - member inline __.Zero () = Empty.Invoke () : '``MonadPlus<'T>`` - member inline __.Combine (a: '``MonadPlus<'T>``, b) = a <|> b : '``MonadPlus<'T>`` - - member inline __.WhileImpl (guard, body: '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + member _.YieldFrom expr = expr : '``monad<'t>`` + member _.strict = new MonadPlusStrictBuilder<'``monad<'t>``> () + member inline _.Zero () = Empty.Invoke () : '``MonadPlus<'T>`` + member inline _.Combine (a: '``MonadPlus<'T>``, b) = a <|> b : '``MonadPlus<'T>`` + + #if !NET45 + member inline _.WhileImpl ([]guard, body: '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + #else + member inline _.WhileImpl (guard, body: '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + #endif let rec fix () = Delay.Invoke (fun () -> if guard () then body <|> fix () else Empty.Invoke ()) fix () + #if !NET45 + member inline this.While ([]guard, body: '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + #else member inline this.While (guard, body: '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = + #endif // Check the type is lazy, otherwise display a warning. let __ () = TryWith.InvokeForWhile (Unchecked.defaultof<'``MonadPlus<'T>``>) (fun (_: exn) -> Unchecked.defaultof<'``MonadPlus<'T>``>) : '``MonadPlus<'T>`` this.WhileImpl (guard, body) + #if !NET45 + member inline this.For (p: #seq<'T>, []rest: 'T->'``MonadPlus<'U>``) : '``MonadPlus<'U>`` = + #else member inline this.For (p: #seq<'T>, rest: 'T->'``MonadPlus<'U>``) : '``MonadPlus<'U>`` = + #endif let mutable isReallyDelayed = true Delay.Invoke (fun () -> isReallyDelayed <- false; Empty.Invoke () : '``MonadPlus<'U>``) |> ignore Using.Invoke (p.GetEnumerator () :> IDisposable) (fun enum -> @@ -222,36 +279,48 @@ module GenericBuilders = type MonadFxBuilder<'``monad<'t>``> () = inherit DelayedBuilder<'``monad<'t>``> () - member __.strict = new MonadFxStrictBuilder<'``monad<'t>``> () + member _.strict = new MonadFxStrictBuilder<'``monad<'t>``> () /// Makes it a (lazy) monadplus computation expression. - member __.plus = new MonadPlusBuilder<'``monad<'t>``> () + member _.plus = new MonadPlusBuilder<'``monad<'t>``> () /// Makes it a strict monadplus computation expression. - member __.plus' = new MonadPlusStrictBuilder<'``monad<'t>``> () + member _.plus' = new MonadPlusStrictBuilder<'``monad<'t>``> () /// Makes it a (lazy) monadic computation expression with side-effects member this.fx = this /// Makes it a strict monadic computation expression with side-effects - member __.fx' = new MonadFxStrictBuilder<'``monad<'t>``> () + member _.fx' = new MonadFxStrictBuilder<'``monad<'t>``> () - member inline __.Zero () = result () : '``Monad`` + member inline _.Zero () = result () : '``Monad`` - member inline __.Combine (a: '``Monad``, b) = a >>= (fun () -> b) : '``Monad<'T>`` + member inline _.Combine (a: '``Monad``, b) = a >>= (fun () -> b) : '``Monad<'T>`` - member inline __.WhileImpl (guard, body: '``Monad``) : '``Monad`` = + #if !NET45 + member inline _.WhileImpl ([]guard, body: '``Monad``) : '``Monad`` = + #else + member inline _.WhileImpl (guard, body: '``Monad``) : '``Monad`` = + #endif let rec loop guard body = if guard () then body >>= (fun () -> loop guard body) else result () loop guard body + #if !NET45 + member inline this.While ([]guard, body: '``Monad``) : '``Monad`` = + #else member inline this.While (guard, body: '``Monad``) : '``Monad`` = + #endif // Check the type is lazy, otherwise display a warning. let __ () = TryWith.InvokeForWhile (Unchecked.defaultof<'``Monad``>) (fun (_: exn) -> Unchecked.defaultof<'``Monad``>) : '``Monad`` this.WhileImpl (guard, body) + #if !NET45 + member inline this.For (p: #seq<'T>, []rest: 'T->'``Monad``) : '``Monad``= + #else member inline this.For (p: #seq<'T>, rest: 'T->'``Monad``) : '``Monad``= + #endif let mutable isReallyDelayed = true Delay.Invoke (fun () -> isReallyDelayed <- false; Return.Invoke () : '``Monad``) |> ignore Using.Invoke (p.GetEnumerator () :> IDisposable) (fun enum -> @@ -265,7 +334,11 @@ module GenericBuilders = member _.ReturnFrom (expr) = expr : '``applicative<'t>`` member inline _.Return (x: 'T) = result x : '``Applicative<'T>`` member inline _.Yield (x: 'T) = result x : '``Applicative<'T>`` + #if !NET45 + member inline _.BindReturn(x, []f) = map f x : '``Applicative<'U>`` + #else member inline _.BindReturn(x, f) = map f x : '``Applicative<'U>`` + #endif member inline _.MergeSources (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``) : '``Applicative<'T * 'U>`` = Lift2.Invoke tuple2 t1 t2 member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = Lift3.Invoke tuple3 t1 t2 t3 member _.Run f = f : '``applicative<'t>`` @@ -275,7 +348,11 @@ module GenericBuilders = member _.ReturnFrom expr : '``applicative1>`` = expr member inline _.Return (x: 'T) : '``Applicative1>`` = (result >> result) x member inline _.Yield (x: 'T) : '``Applicative1>`` = (result >> result) x + #if !NET45 + member inline _.BindReturn (x: '``Applicative1>``, []f: _ -> _) : '``Applicative1>`` = (map >> map) f x + #else member inline _.BindReturn (x: '``Applicative1>``, f: _ -> _) : '``Applicative1>`` = (map >> map) f x + #endif member inline _.MergeSources (t1, t2) : '``Applicative1>`` = (lift2 >> lift2) tuple2 t1 t2 member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (lift3 >> lift3) tuple3 t1 t2 t3 member _.Run x : '``applicative1>`` = x @@ -285,7 +362,11 @@ module GenericBuilders = member _.ReturnFrom expr : '``applicative1>>`` = expr member inline _.Return (x: 'T) : '``Applicative1>>`` = (result >> result >> result) x member inline _.Yield (x: 'T) : '``Applicative1>>`` = (result >> result >> result) x + #if !NET45 + member inline _.BindReturn (x: '``Applicative1>>``, []f: _ -> _) : '``Applicative1>`` = (map >> map >> map) f x + #else member inline _.BindReturn (x: '``Applicative1>>``, f: _ -> _) : '``Applicative1>`` = (map >> map >> map) f x + #endif member inline _.MergeSources (t1, t2) : '``Applicative1>>`` = (lift2 >> lift2 >> lift2) tuple2 t1 t2 member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>>`` = (lift3 >> lift3 >> lift3) tuple3 t1 t2 t3 member _.Run x : '``applicative1>>`` = x diff --git a/src/FSharpPlus/Control/Functor.fs b/src/FSharpPlus/Control/Functor.fs index ecf1aef5b..8a4ab31fc 100644 --- a/src/FSharpPlus/Control/Functor.fs +++ b/src/FSharpPlus/Control/Functor.fs @@ -158,7 +158,7 @@ type Unzip = #endif static member Unzip ((source: Async<'T * 'U> , _output: Async<'T> * Async<'U> ) , _mthd: Unzip ) = Map.Invoke fst source, Map.Invoke snd source - static member Unzip ((source: Result<'T * 'U, 'E> , _output: Result<'T,'E> * Result<'U,'E> ) , _mthd: Unzip ) = Map.Invoke fst source, Map.Invoke snd source + static member Unzip ((source: Result<'T * 'U, 'E> , _output: Result<'T,'E> * Result<'U,'E> ) , _mthd: Unzip ) = Result.unzip source static member Unzip ((source: Choice<'T * 'U, 'E> , _output: Choice<'T,'E> * Choice<'U,'E> ) , _mthd: Unzip ) = Map.Invoke fst source, Map.Invoke snd source static member Unzip ((source: KeyValuePair<'Key, 'T * 'U> , _output: KeyValuePair<_, 'T> * KeyValuePair<_, 'U> ) , _mthd: Unzip ) = Map.Invoke fst source, Map.Invoke snd source static member Unzip ((source: Map<'Key, 'T * 'U> , _output: Map<_, 'T> * Map<_, 'U> ) , _mthd: Unzip ) = Map.unzip source @@ -205,6 +205,7 @@ type Zip = static member Zip ((x: 'T [] , y: 'U [] , _output: ('T*'U) [] ), _mthd: Zip) = Array.zipShortest x y static member Zip ((x: ResizeArray<'T> , y: ResizeArray<'U> , _output: ResizeArray<'T*'U> ), _mthd: Zip) = ResizeArray.zipShortest x y static member Zip ((x: option<'T> , y: option<'U> , _output: option<'T*'U> ), _mthd: Zip) = Option.zip x y + static member Zip ((x: Result<'T, 'Error> , y: Result<'U, 'Error> , _output: Result<'T * 'U, 'Error> ), _mthd: Zip) = Result.zip x y static member Zip ((x: Async<'T> , y: Async<'U> , _output: Async<'T*'U> ), _mthd: Zip) = Async.zip x y #if !FABLE_COMPILER static member Zip ((x: Task<'T> , y: Task<'U> , _output: Task<'T*'U> ), _mthd: Zip) = Task.zip x y diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs index e689c4655..7b65729ab 100644 --- a/src/FSharpPlus/Data/Validation.fs +++ b/src/FSharpPlus/Data/Validation.fs @@ -27,6 +27,7 @@ type Validation<'error, 't> = | Success of 't module Validation = + open FSharp.Core.CompilerServices let map (f: 'T->'U) (source: Validation<'Error,'T>) = match source with @@ -228,6 +229,7 @@ module Validation = /// A tuple with both resulting lists, Success are in the first list. /// let partition (source: list>) = + #if FABLE_COMPILER || NET45 let rec loop ((acc1, acc2) as acc) = function | [] -> acc | x::xs -> @@ -235,6 +237,12 @@ module Validation = | Success x -> loop (x::acc1, acc2) xs | Failure x -> loop (acc1, x::acc2) xs loop ([], []) (List.rev source) + #else + let mutable coll1 = new ListCollector<'T> () + let mutable coll2 = new ListCollector<'TErrors> () + List.iter (function Success e -> coll1.Add e | Failure e -> coll2.Add e) source + coll1.Close (), coll2.Close () + #endif type Validation<'err,'a> with diff --git a/src/FSharpPlus/Extensions/Array.fs b/src/FSharpPlus/Extensions/Array.fs index 45d100a10..e2d794314 100644 --- a/src/FSharpPlus/Extensions/Array.fs +++ b/src/FSharpPlus/Extensions/Array.fs @@ -5,6 +5,8 @@ namespace FSharpPlus module Array = open System + open FSharp.Core.CompilerServices + open FSharpPlus.Internals.Errors /// Applies an array of functions to an array of values and concatenates them. /// The array of functions. @@ -18,13 +20,22 @@ module Array = /// /// let apply f x = + #if !NET45 + raiseIfNull (nameof(x)) x + #endif + let lenf, lenx = Array.length f, Array.length x - Array.init (lenf * lenx) (fun i -> f.[i / lenx] x.[i % lenx]) + Array.init (lenf * lenx) (fun i -> let (d, r) = Math.DivRem (i, lenx) in f.[d] x.[r]) /// Combines all values from the first array with the second, using the supplied mapping function. let lift2 f x y = + #if !NET45 + raiseIfNull (nameof(x)) x + raiseIfNull (nameof(y)) y + #endif + let lenx, leny = Array.length x, Array.length y - Array.init (lenx * leny) (fun i -> f x.[i / leny] y.[i % leny]) + Array.init (lenx * leny) (fun i -> let (d, r) = Math.DivRem (i, leny) in f x.[d] y.[r]) /// Combines all values from three arrays and calls a mapping function on this combination. @@ -35,23 +46,114 @@ module Array = /// /// Array with values returned from mapping function. let lift3 mapping list1 list2 list3 = + #if !NET45 + raiseIfNull (nameof(list1)) list1 + raiseIfNull (nameof(list2)) list2 + raiseIfNull (nameof(list3)) list3 + #endif + let lenx, leny, lenz = Array.length list1, Array.length list2, Array.length list3 - let combinedFirstTwo = Array.init (lenx * leny) (fun i -> (list1.[i / leny], list2.[i % leny])) + let combinedFirstTwo = Array.init (lenx * leny) (fun i -> let (d, r) = Math.DivRem (i, leny) in (list1.[d], list2.[r])) - Array.init (lenx * leny * lenz) (fun i -> combinedFirstTwo.[i/leny], list3.[i%leny]) + Array.init (lenx * leny * lenz) (fun i -> let (d, r) = Math.DivRem (i, leny) in combinedFirstTwo.[d], list3.[r]) |> Array.map (fun x -> mapping (fst (fst x)) (snd (fst x)) (snd x)) /// Concatenates all elements, using the specified separator between each element. - let intercalate (separator: _ []) (source: seq<_ []>) = source |> Seq.intercalate separator |> Seq.toArray + let intercalate (separator: 'T []) (source: seq<'T []>) = + #if !NET45 + raiseIfNull (nameof(source)) source + #endif + #if FABLE_COMPILER || NET45 + source |> Seq.intercalate separator |> Seq.toArray + #else + let mutable coll = new ArrayCollector<'T> () + let mutable notFirst = false + source |> Seq.iter (fun element -> + if notFirst then coll.AddMany separator + coll.AddMany element + notFirst <- true) + coll.Close () + #endif /// Inserts a separator element between each element in the source array. - let intersperse element source = source |> Array.toSeq |> Seq.intersperse element |> Seq.toArray : 'T [] + let intersperse element (source: 'T []) = + #if !NET45 + raiseIfNull (nameof(source)) source + #endif + + match source with + | [||] -> [||] + | _ -> + let finalLength = Array.length source * 2 - 1 + Array.init finalLength (fun i -> + match Math.DivRem (i, 2) with + | i, 0 -> source.[i] + | _ -> element) /// Creates a sequence of arrays by splitting the source array on any of the given separators. - let split (separators: seq<_ []>) (source: _ []) = source |> Array.toSeq |> Seq.split separators |> Seq.map Seq.toArray + let split (separators: seq<_ []>) (source: _ []) = + #if !NET45 + raiseIfNull (nameof(separators)) separators + raiseIfNull (nameof(source)) source + #endif + + source |> Array.toSeq |> Seq.split separators |> Seq.map Seq.toArray /// Replaces a subsequence of the source array with the given replacement array. - let replace oldValue newValue source = source |> Array.toSeq |> Seq.replace oldValue newValue |> Seq.toArray : 'T [] + let replace (oldValue: 'T seq) (newValue: 'T seq) (source: 'T[]) : 'T[] = + #if !NET45 + raiseIfNull (nameof(oldValue)) oldValue + raiseIfNull (nameof(newValue)) newValue + raiseIfNull (nameof(source)) source + #endif + #if FABLE_COMPILER || NET45 + source |> Array.toSeq |> Seq.replace oldValue newValue |> Seq.toArray: 'T [] + #else + let oldValueArray = oldValue |> Seq.toArray + let newValueArray = newValue |> Seq.toArray + match source with + | [||] -> [||] + | _ -> + let mutable candidate = new ArrayCollector<'T>() + let mutable sourceIndex = 0 + + while sourceIndex < source.Length do + let sourceItem = source.[sourceIndex] + + if sourceItem = oldValueArray.[0] + && sourceIndex + newValueArray.Length <= source.Length then + let middleIndex = (oldValueArray.Length - 1) / 2 + let mutable oldValueIndexLeft = 0 + + let mutable oldValueIndexRight = + oldValueArray.Length - 1 + + let mutable matchingElements = + source.[sourceIndex + oldValueIndexLeft] = oldValueArray.[oldValueIndexLeft] + && source.[sourceIndex + oldValueIndexRight] = oldValueArray.[oldValueIndexRight] + + while oldValueIndexLeft <= middleIndex + && oldValueIndexRight >= middleIndex + && matchingElements do + matchingElements <- + source.[sourceIndex + oldValueIndexLeft] = oldValueArray.[oldValueIndexLeft] + && source.[sourceIndex + oldValueIndexRight] = oldValueArray.[oldValueIndexRight] + + oldValueIndexLeft <- oldValueIndexLeft + 1 + oldValueIndexRight <- oldValueIndexRight - 1 + + if matchingElements then + candidate.AddMany newValueArray + sourceIndex <- sourceIndex + oldValueArray.Length + else + candidate.Add sourceItem + sourceIndex <- sourceIndex + 1 + else + sourceIndex <- sourceIndex + 1 + candidate.Add sourceItem + + candidate.Close() + #endif /// /// Returns the index of the first occurrence of the specified slice in the source. @@ -72,6 +174,11 @@ module Array = /// The index of the slice or None. /// let findSliceIndex (slice: _ []) (source: _ []) = + #if !NET45 + raiseIfNull (nameof(slice)) slice + raiseIfNull (nameof(source)) source + #endif + let index = Internals.FindSliceIndex.arrayImpl slice source if index = -1 then ArgumentException("The specified slice was not found in the sequence.") |> raise @@ -86,6 +193,11 @@ module Array = /// The index of the slice or None. /// let tryFindSliceIndex (slice: _ []) (source: _ []) = + #if !NET45 + raiseIfNull (nameof(slice)) slice + raiseIfNull (nameof(source)) source + #endif + let index = Internals.FindSliceIndex.arrayImpl slice source if index = -1 then None else Some index #endif @@ -98,6 +210,10 @@ module Array = /// A tuple with both resulting arrays. /// let partitionMap (mapper: 'T -> Choice<'T1,'T2>) (source: array<'T>) = + #if !NET45 + raiseIfNull (nameof(source)) source + #endif + let (x, y) = ResizeArray (), ResizeArray () Array.iter (mapper >> function Choice1Of2 e -> x.Add e | Choice2Of2 e -> y.Add e) source x.ToArray (), y.ToArray () @@ -106,6 +222,11 @@ module Array = /// to each of the elements of the two arrays pairwise. /// If one array is shorter, excess elements are discarded from the right end of the longer array. let map2Shortest f (a1: 'T []) (a2: 'U []) = + #if !NET45 + raiseIfNull (nameof(a1)) a1 + raiseIfNull (nameof(a2)) a2 + #endif + Array.init (min a1.Length a2.Length) (fun i -> f a1.[i] a2.[i]) /// @@ -115,6 +236,11 @@ module Array = /// Second input array. /// Array with corresponding pairs of input arrays. let zipShortest (a1: array<'T1>) (a2: array<'T2>) = + #if !NET45 + raiseIfNull (nameof(a1)) a1 + raiseIfNull (nameof(a2)) a2 + #endif + Array.init (min a1.Length a2.Length) (fun i -> a1.[i], a2.[i]) /// Same as choose but with access to the index. @@ -123,6 +249,10 @@ module Array = /// /// Array with values x for each Array value where the function returns Some(x). let choosei mapping source = + #if !NET45 + raiseIfNull (nameof(source)) source + #endif + let mutable i = ref -1 let fi x = i.Value <- i.Value + 1 diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index 7fc8b87d7..4bf560118 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -35,6 +35,7 @@ module Extensions = open System.Threading open System.Threading.Tasks + open FSharp.Core.CompilerServices let private (|Canceled|Faulted|Completed|) (t: Task<'a>) = if t.IsCanceled then Canceled @@ -74,11 +75,20 @@ module Extensions = #endif /// Combine all asyncs in one, chaining them in sequence order. - static member Sequence (t: list>) : Async> = + static member Sequence (t: list>) : Async> = + #if FABLE_COMPILER || NET45 let rec loop acc = function | [] -> async.Return (List.rev acc) | x::xs -> async.Bind (x, fun x -> loop (x::acc) xs) loop [] t + #else + async { + let mutable coll = ListCollector<'T> () + for e in t do + let! v = e + coll.Add v + return coll.Close () } + #endif /// Combine all asyncs in one, chaining them in sequence order. static member Sequence (t: array>) : Async> = async { diff --git a/src/FSharpPlus/Extensions/List.fs b/src/FSharpPlus/Extensions/List.fs index f093a803a..990d74c02 100644 --- a/src/FSharpPlus/Extensions/List.fs +++ b/src/FSharpPlus/Extensions/List.fs @@ -5,15 +5,35 @@ namespace FSharpPlus module List = open System + open FSharp.Core.CompilerServices - /// Creates a list with a single element. - let singleton x = [x] + /// Returns a list that contains one item only. + /// + /// The input item. + /// + /// The result list of one item. + /// + /// + /// + /// List.singleton 7 + /// + /// Evaluates to [ 7 ]. + /// + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// + let singleton value = [value] : list<'T> /// Adds an element to the beginning of the given list - /// The element to add + /// The element to add /// The list to add to /// A concatenated list of the result lists of applying each function to each value - let cons x list = x :: list + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// + let cons value list = value :: list : list<'T> /// Applies a list of functions to a list of values and concatenates them /// The list of functions. @@ -26,10 +46,28 @@ module List = /// val it : int list = [2; 4; 6; 3; 6; 9] /// /// - let apply f x = List.collect (fun f -> List.map ((<|) f) x) f + let apply (f: list<'T -> 'U>) (x: list<'T>) : list<'U> = + #if FABLE_COMPILER || NET45 + List.collect (fun f -> List.map ((<|) f) x) f + #else + let mutable coll = ListCollector<'U> () + f |> List.iter (fun f -> + x |> List.iter (fun x -> + coll.Add (f x))) + coll.Close () + #endif /// Combines all values from the first list with the second, using the supplied mapping function. - let lift2 f x1 x2 = List.allPairs x1 x2 |> List.map (fun (x, y) -> f x y) + let lift2 (f: 'T1 -> 'T2 -> 'U) (x1: list<'T1>) (x2: list<'T2>) = + #if FABLE_COMPILER || NET45 + List.allPairs x1 x2 |> List.map (fun (x, y) -> f x y) + #else + let mutable coll = ListCollector<'U> () + x1 |> List.iter (fun x1 -> + x2 |> List.iter (fun x2 -> + coll.Add (f x1 x2))) + coll.Close () + #endif /// Combines values from three list and calls a mapping function on this combination. /// Mapping function taking three element combination as input. @@ -39,21 +77,111 @@ module List = /// /// List with values returned from mapping function. let lift3 f x1 x2 x3 = + #if !FABLE_COMPILER || FABLE_COMPILER_3 || NET45 List.allPairs x2 x3 |> List.allPairs x1 |> List.map (fun x -> (fst (snd x), snd (snd x), fst x)) |> List.map (fun (x, y, z) -> f x y z) + #else + let mutable coll = ListCollector<'U> () + x1 |> List.iter (fun x1 -> + x2 |> List.iter (fun x2 -> + x3 |> List.iter (fun x3 -> + coll.Add (f x1 x2 x3)))) + coll.Close () + #endif /// Returns a list with all possible tails of the source list. - let tails x = let rec loop = function [] -> [] | _::xs as s -> s::(loop xs) in loop x + let tails list = let rec loop = function [] -> [] | _::xs as s -> s::(loop xs) in loop list : list> - let take i list = Seq.take i list |> Seq.toList - let skip i list = - let rec listSkip lst = function - | 0 -> lst - | n -> listSkip (List.tail lst) (n-1) - listSkip list i + /// Returns the first N elements of the list. + /// Throws InvalidOperationException + /// if the count exceeds the number of elements in the list. List.truncate + /// returns as many items as the list contains instead of throwing an exception. + /// + /// The number of items to take. + /// The input list. + /// + /// The result list. + /// + /// Thrown when the input list is empty. + /// Thrown when count exceeds the number of elements + /// in the list. + /// + /// + /// + /// let inputs = ["a"; "b"; "c"; "d"] + /// + /// inputs |> List.take 2 + /// + /// Evaluates to ["a"; "b"] + /// + /// + /// + /// + /// let inputs = ["a"; "b"; "c"; "d"] + /// + /// inputs |> List.take 6 + /// + /// Throws InvalidOperationException. + /// + /// + /// + /// + /// let inputs = ["a"; "b"; "c"; "d"] + /// + /// inputs |> List.take 0 + /// + /// Evaluates to the empty list. + /// + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// + let take count list = FSharp.Collections.List.take<'T> count list + + /// Returns the list after removing the first N elements. + /// + /// The number of elements to skip. If the number is 0 or negative the input list is returned. + /// The input list. + /// + /// The list after removing the first N elements. + /// + /// Thrown when count exceeds the number of + /// elements in the list. + /// + /// + /// + /// let inputs = ["a"; "b"; "c"; "d"] + /// + /// inputs |> List.skip 2 + /// + /// Evaluates to ["c"; "d"] + /// + /// + /// + /// + /// let inputs = ["a"; "b"; "c"; "d"] + /// + /// inputs |> List.skip 5 + /// + /// Throws ArgumentException. + /// + /// + /// + /// + /// let inputs = ["a"; "b"; "c"; "d"] + /// + /// inputs |> List.skip -1 + /// + /// Evaluates to ["a"; "b"; "c"; "d"]. + /// + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// + let skip count list = FSharp.Collections.List.skip<'T> count list /// Returns a list that drops N elements of the original list and then yields the @@ -64,18 +192,40 @@ module List = /// The input list. /// /// The result list. - let drop count source = + let drop<'T> count source = let rec loop i lst = match lst, i with | [] as x, _ | x, 0 -> x - | x, n -> loop (n-1) (List.tail x) + | x, n -> loop (n-1) (List.tail<'T> x) if count > 0 then loop count source else source /// Concatenates all elements, using the specified separator between each element. - let intercalate (separator: list<_>) (source: seq>) = source |> Seq.intercalate separator |> Seq.toList + let intercalate (separator: list<'T>) (source: seq>) = + #if FABLE_COMPILER || NET45 + source |> Seq.intercalate separator |> Seq.toList + #else + let mutable coll = new ListCollector<'T> () + let mutable notFirst = false + source |> Seq.iter (fun element -> + if notFirst then coll.AddMany separator + coll.AddMany element + notFirst <- true) + coll.Close () + #endif /// Inserts a separator element between each element in the source list. - let intersperse element source = source |> List.toSeq |> Seq.intersperse element |> Seq.toList : list<'T> + let intersperse separator (source: list<'T>) = + #if FABLE_COMPILER || NET45 + source |> List.toSeq |> Seq.intersperse separator |> Seq.toList + #else + let mutable coll = new ListCollector<'T> () + let mutable notFirst = false + source |> List.iter (fun element -> + if notFirst then coll.Add separator + coll.Add element + notFirst <- true) + coll.Close () + #endif /// Creates a sequence of lists by splitting the source list on any of the given separators. let split (separators: seq>) (source: list<_>) = source |> List.toSeq |> Seq.split separators |> Seq.map Seq.toList @@ -130,23 +280,44 @@ module List = /// /// A tuple with both resulting lists. /// - let partitionMap (mapping: 'T -> Choice<'T1,'T2>) (source: list<'T>) = + let partitionMap (mapping: 'T -> Choice<'T1, 'T2>) (source: list<'T>) = + #if FABLE_COMPILER || NET45 let rec loop ((acc1, acc2) as acc) = function - | [] -> acc + | [] -> acc | x::xs -> match mapping x with | Choice1Of2 x -> loop (x::acc1, acc2) xs | Choice2Of2 x -> loop (acc1, x::acc2) xs loop ([], []) (List.rev source) + #else + let mutable coll1 = new ListCollector<'T1> () + let mutable coll2 = new ListCollector<'T2> () + List.iter (mapping >> function Choice1Of2 e -> coll1.Add e | Choice2Of2 e -> coll2.Add e) source + coll1.Close (), coll2.Close () + #endif /// Safely build a new list whose elements are the results of applying the given function /// to each of the elements of the two lists pairwise. + /// Mapping function. + /// First input list. + /// Second input list. + /// List with corresponding results of applying the mapping function pairwise over both input lists elments. /// If one list is shorter, excess elements are discarded from the right end of the longer list. - let map2Shortest f (l1: list<_>) (l2: list<_>) = + let map2Shortest mapping (list1: list<'T1>) (list2: list<'T2>) : list<'U> = + #if FABLE_COMPILER || NET45 let rec loop acc = function - | (l::ls,r::rs) -> loop ((f l r)::acc) (ls,rs) - | (_,_) -> acc - loop [] (l1,l2) |> List.rev + | (l::ls, r::rs) -> loop ((mapping l r)::acc) (ls, rs) + | (_, _) -> acc + loop [] (list1, list2) |> List.rev + #else + let mutable coll = new ListCollector<'U> () + let rec loop = function + | ([], _) | (_, []) -> coll.Close () + | (l::ls, r::rs) -> + coll.Add (mapping l r) + loop (ls, rs) + loop (list1, list2) + #endif /// /// Zip safely two lists. If one list is shorter, excess elements are discarded from the right end of the longer list. @@ -154,11 +325,21 @@ module List = /// First input list. /// Second input list. /// List with corresponding pairs of input lists. - let zipShortest (list1: list<'T1>) (list2: list<'T2>) = + let zipShortest (list1: list<'T1>) (list2: list<'T2>) : list<'T1 * 'T2> = + #if FABLE_COMPILER || NET45 let rec loop acc = function | (l::ls, r::rs) -> loop ((l, r)::acc) (ls, rs) | (_, _) -> acc loop [] (list1, list2) |> List.rev + #else + let mutable coll = new ListCollector<'T1 * 'T2> () + let rec loop = function + | ([], _) | (_, []) -> coll.Close () + | (l::ls,r::rs) -> + coll.Add (l, r) + loop (ls,rs) + loop (list1, list2) + #endif /// Same as choose but with access to the index. /// The mapping function, taking index and element as parameters. @@ -177,10 +358,19 @@ module List = /// The input list /// /// For invalid indexes, the input list. Otherwise, a new list with the item removed. - let removeAt i lst = - if List.length lst > i then - lst.[0..i-1] @ lst.[i+1..] - else lst + let deleteAt i lst = + if List.length lst > i then + lst.[0..i-1] @ lst.[i+1..] + else lst + + /// Attempts to remove an item from a list. + /// The index of the item to remove + /// The input list + /// + /// For invalid indexes, the input list. Otherwise, a new list with the item removed. + /// Use deletaAt instead or if you want to throw exceptions use the full path to removeAt in FSharp.Core until this function is removed from this library. + [] + let removeAt i lst = deleteAt i lst /// Updates the value of an item in a list /// The index of the item to update @@ -188,7 +378,9 @@ module List = /// The input list /// /// A new list with the updated element + /// Use List.updateAt if you want to throw exceptions when using invalid indexes. let setAt i x lst = if List.length lst > i && i >= 0 then lst.[0..i-1] @ x::lst.[i+1..] else lst + diff --git a/src/FSharpPlus/Extensions/Map.fs b/src/FSharpPlus/Extensions/Map.fs index 2cca37334..c6d241faf 100644 --- a/src/FSharpPlus/Extensions/Map.fs +++ b/src/FSharpPlus/Extensions/Map.fs @@ -1,4 +1,5 @@ namespace FSharpPlus +open System /// Additional operations on Map<'Key, 'Value> [] @@ -16,12 +17,20 @@ module Map = /// The input map. /// /// A seq of the keys in the map. + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// let keys (source: Map<'Key, 'T>) = Seq.map (fun (KeyValue(k, _)) -> k) source /// Returns the values of the given map. /// The input map. /// /// A seq of the values in the map. + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// let values (source: Map<'Key, 'T>) = Seq.map (fun (KeyValue(_, v)) -> v) source /// Maps the values of the original Map. diff --git a/src/FSharpPlus/Extensions/Option.fs b/src/FSharpPlus/Extensions/Option.fs index 25f3d55cc..cdf108560 100644 --- a/src/FSharpPlus/Extensions/Option.fs +++ b/src/FSharpPlus/Extensions/Option.fs @@ -29,6 +29,16 @@ module Option = | Some x, Some y -> Some (x, y) | _ -> None + /// If all 3 value are Some, returns them tupled. Otherwise it returns None. + /// The first value. + /// The second value. + /// The third value. + /// The resulting option. + let zip3 x y z : option<'T * 'U * 'V> = + match x, y, z with + | Some x, Some y, Some z -> Some (x, y, z) + | _ -> None + /// Converts an option to a Result. /// The option value. /// The resulting Result value. diff --git a/src/FSharpPlus/Extensions/Result.fs b/src/FSharpPlus/Extensions/Result.fs index 1bfe54630..ff128ea25 100644 --- a/src/FSharpPlus/Extensions/Result.fs +++ b/src/FSharpPlus/Extensions/Result.fs @@ -3,11 +3,15 @@ namespace FSharpPlus /// Additional operations on Result<'T,'Error> [] module Result = + open FSharp.Core.CompilerServices + open System /// Creates an Ok with the supplied value. + [] let result value : Result<'T,'Error> = Ok value /// Creates an Error With the supplied value. + [] let throw value : Result<'T,'Error> = Error value /// Applies the wrapped value to the wrapped function when both are Ok and returns a wrapped result or the first Error. @@ -16,7 +20,26 @@ module Result = /// An Ok of the function applied to the value, or the first Error if either the function or the value is Error. let apply f (x: Result<'T,'Error>) : Result<'U,'Error> = match f, x with Ok a, Ok b -> Ok (a b) | Error e, _ | _, Error e -> Error e + /// If value is Ok, returns both of them tupled. Otherwise it returns the Error value twice in a tuple. + /// The value. + /// The resulting tuple. + let unzip (source: Result<'T * 'U, 'Error>) : Result<'T, 'Error> * Result<'U, 'Error> = match source with Ok (x, y) -> Ok x, Ok y | Error e -> Error e, Error e + /// Creates a Result value from a pair of Result values. + /// The first Result value. + /// The second Result value. + /// + /// The tupled value, or the first Error. + let zip (x: Result<'T, 'Error>) (y: Result<'U, 'Error>) : Result<'T * 'U, 'Error> = match x, y with Ok a, Ok b -> Ok (a, b) | Error e, _ | _, Error e -> Error e + + /// Creates a Result value from a three Result values. + /// The first Result value. + /// The second Result value. + /// The third Result value. + /// + /// The tupled value, or the first Error. + let zip3 (x: Result<'T, 'Error>) (y: Result<'U, 'Error>) (z: Result<'V, 'Error>) : Result<'T * 'U * 'V, 'Error> = match x, y, z with Ok a, Ok b, Ok c -> Ok (a, b, c) | Error e, _, _ | _, Error e, _ | _, _, Error e -> Error e + /// Creates a Result value from a pair of Result values, using a function to combine them. /// The mapping function. /// The first Result value. @@ -76,11 +99,27 @@ module Result = | :? exn as e -> raise <| System.ArgumentException ("Result value was Error", "source", e) | e -> invalidArg "source" ("Result value was Error: " + string e) - /// Extracts the Ok value or use the supplied default value when it's an Error. - let defaultValue (value:'T) (source: Result<'T,'Error>) : 'T = match source with Ok v -> v | _ -> value + /// Gets the value of the result if the result is Ok, otherwise returns the specified default value. + /// + /// The specified default value. + /// The input result. + /// + /// The result if the result is Ok, else the default value. + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// + let defaultValue (value:'T) (result: Result<'T,'Error>) : 'T = match result with Ok v -> v | _ -> value - /// Extracts the Ok value or applies the compensation function over the Error. - let defaultWith (compensation: 'Error->'T) (source: Result<'T,'Error>) : 'T = match source with Ok v -> v | Error e -> compensation e + /// Gets the value of the result if the result is Ok, otherwise evaluates and returns the result. + /// + /// A thunk that provides a default value when evaluated. + /// The input result. + /// + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. + /// + let defaultWith (defThunk: 'Error->'T) (result: Result<'T,'Error>) : 'T = match result with Ok v -> v | Error e -> defThunk e /// Converts a Result<'T,'Error> to a Choice<'T,'Error>. let toChoice (source: Result<'T,'U>) = match source with Ok x-> Choice1Of2 x | Error x -> Choice2Of2 x @@ -94,7 +133,8 @@ module Result = /// /// A tuple with both resulting lists, Oks are in the first list. /// - let partition (source: list>) = + let partition (source: list>) = + #if FABLE_COMPILER || NET45 let rec loop ((acc1, acc2) as acc) = function | [] -> acc | x::xs -> @@ -102,3 +142,9 @@ module Result = | Ok x -> loop (x::acc1, acc2) xs | Error x -> loop (acc1, x::acc2) xs loop ([], []) (List.rev source) + #else + let mutable coll1 = new ListCollector<'T> () + let mutable coll2 = new ListCollector<'Error> () + List.iter (function Ok e -> coll1.Add e | Error e -> coll2.Add e) source + coll1.Close (), coll2.Close () + #endif diff --git a/src/FSharpPlus/Extensions/Seq.fs b/src/FSharpPlus/Extensions/Seq.fs index 030360f8b..44f1e3a10 100644 --- a/src/FSharpPlus/Extensions/Seq.fs +++ b/src/FSharpPlus/Extensions/Seq.fs @@ -49,15 +49,18 @@ module Seq = |> Seq.map (fun x -> (fst (snd x), snd (snd x), fst x)) |> Seq.map (fun (x, y, z) -> f x y z) - /// - /// Applies a function to each element of the collection, starting from the end, - /// threading an accumulator argument through the computation. - /// + /// Applies a function to each element of the collection, starting from the end, threading an accumulator argument + /// through the computation. If the input function is f and the elements are i0...iN + /// then computes f i0 (... (f iN s)...) + /// + /// The function to update the state given the input elements. + /// The input sequence. + /// The initial state. /// - /// Note: this function has since been added to FSharpCore, so effectively - /// overrides it. It will be removed in next major release of FSharpPlus. + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. /// - let foldBack f x z = Array.foldBack f (Seq.toArray x) z + let foldBack folder source state = Array.foldBack folder (Seq.toArray source) state /// /// Chunks the seq up into groups with the same projected key by applying @@ -176,13 +179,16 @@ module Seq = } #if !FABLE_COMPILER - - /// - /// Creates a sequence by replicating the given initial value count times. - /// + + /// Creates a sequence by replicating the given initial value. + /// + /// The number of elements to replicate. + /// The value to replicate + /// + /// The generated sequence. /// - /// Note: this function has since been added to FSharpCore, so effectively - /// overrides it. It will be removed in next major release of FSharpPlus. + /// Note: this function has since been added to FSharp.Core. + /// It will be removed in next major release of FSharpPlus. /// let replicate count initial = Linq.Enumerable.Repeat (initial, count) #endif diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index 6b0f4c5be..90ef793a1 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -14,10 +14,7 @@ $(VersionPrefix).0 1368368e-d2f4-4fef-bb2f-492e05156e0f true - --warnon:1182 --warnon:3390 $(OtherFlags) - --warnon:1182 --warnon:3390 $(OtherFlags) - --warnon:1182 $(OtherFlags) - --warnon:1182 $(OtherFlags) + --warnon:1182 --warnon:3390 $(OtherFlags) false false false @@ -125,6 +122,7 @@ - + + diff --git a/src/FSharpPlus/Internals.fs b/src/FSharpPlus/Internals.fs index b90e1551f..52b48c9fa 100644 --- a/src/FSharpPlus/Internals.fs +++ b/src/FSharpPlus/Internals.fs @@ -36,7 +36,6 @@ module internal Prelude = System.Tuple<_> x #endif - [] module internal Implicit = let inline Invoke (x: ^t) = ((^R or ^t) : (static member op_Implicit : ^t -> ^R) x) : ^R @@ -48,6 +47,10 @@ module Errors = let exnNoSubtraction = new System.Exception "No subtraction defined for these values in this domain." let exnUnreachable = new System.InvalidOperationException "This execution path is unreachable." + let inline raiseIfNull paramName paramValue = + if isNull paramValue then + nullArg paramName + module Decimal = let inline trySqrt x = match sign x with diff --git a/src/FSharpPlus/Operators.fs b/src/FSharpPlus/Operators.fs index 95c14d424..539bf0888 100644 --- a/src/FSharpPlus/Operators.fs +++ b/src/FSharpPlus/Operators.fs @@ -296,7 +296,7 @@ module Operators = /// Combines two monoids in one. /// /// Monoid - let inline plus (x: 'Monoid) (y: 'Monoid) : 'Monoid = Plus.Invoke x y + let inline plus< ^Monoid when (Plus or ^Monoid) : (static member ``+`` : ^Monoid * ^Monoid * Plus -> ^Monoid)> (x: 'Monoid) (y: 'Monoid) : 'Monoid = Plus.Invoke x y module Seq = @@ -304,7 +304,7 @@ module Operators = /// Folds all values in the sequence using the monoidal addition. /// /// Monoid - let inline sum (x: seq<'Monoid>) : 'Monoid = Sum.Invoke x + let inline sum< ^Monoid when (Sum or seq< ^Monoid> or ^Monoid) : (static member Sum: seq<'Monoid> * 'Monoid * Sum -> 'Monoid)> (x: seq<'Monoid>) : 'Monoid = Sum.Invoke x // Alternative/Monadplus/Arrowplus ---------------------------------------- @@ -335,7 +335,9 @@ module Operators = /// Common uses of guard include conditionally signaling an error in an error monad and conditionally rejecting the current choice in an Alternative-based parser. /// /// Alternative/Monadplus/Arrowplus - let inline guard x: '``MonadPlus`` = if x then Return.Invoke () else Empty.Invoke () + let inline guard< ^``MonadPlus`` when (Return or ^``MonadPlus``) : + (static member Return: ^``MonadPlus`` * Return -> (unit -> ^``MonadPlus``)) and + (Empty or ^``MonadPlus``) : (static member Empty: ^``MonadPlus`` * Empty -> ^``MonadPlus``)> x : '``MonadPlus`` = if x then Return.Invoke () else Empty.Invoke () // Contravariant/Bifunctor/Profunctor/Invariant --------------------------- @@ -1335,19 +1337,19 @@ module Operators = /// Convert from a byte array value, given options of little-endian, and startIndex /// /// Converter - let inline ofBytesWithOptions (isLtEndian: bool) (startIndex: int) (value: byte[]) = OfBytes.Invoke isLtEndian startIndex value + let inline ofBytesWithOptions< ^T when (OfBytes or ^T) : (static member OfBytes: ^T * OfBytes -> (byte[] * int * bool -> ^T))> (isLtEndian: bool) (startIndex: int) (value: byte[]) : 'T = OfBytes.Invoke isLtEndian startIndex value /// /// Convert from a byte array value, assuming little-endian /// /// Converter - let inline ofBytes (value: byte[]) = OfBytes.Invoke true 0 value + let inline ofBytes< ^T when (OfBytes or ^T) : (static member OfBytes: ^T * OfBytes -> (byte[] * int * bool -> ^T))> (value: byte[]) : 'T = OfBytes.Invoke true 0 value /// /// Convert from a byte array value, assuming big-endian /// /// Converter - let inline ofBytesBE (value: byte[]) = OfBytes.Invoke false 0 value + let inline ofBytesBE< ^T when (OfBytes or ^T) : (static member OfBytes: ^T * OfBytes -> (byte[] * int * bool -> ^T))> (value: byte[]) : 'T = OfBytes.Invoke false 0 value /// /// Convert to a byte array value, assuming little endian @@ -1369,13 +1371,13 @@ module Operators = /// Converts to a value from its string representation. /// /// Converter - let inline parse (value: string) = Parse.Invoke value + let inline parse< ^T when (Parse or ^T) : (static member Parse: ^T * Parse -> (string -> ^T))> (value: string) : 'T = Parse.Invoke value /// /// Converts to a value from its string representation. Returns None if the convertion doesn't succeed. /// /// Converter - let inline tryParse (value: string) = TryParse.Invoke value + let inline tryParse< ^T when (TryParse or ^T) : (static member TryParse: ^T * TryParse -> (string -> ^T option))> (value: string) : 'T option = TryParse.Invoke value // Numerics diff --git a/tests/FSharpPlus.1/General.fs b/tests/FSharpPlus.1/General.fs index 51936eb5c..4b4708f7c 100644 --- a/tests/FSharpPlus.1/General.fs +++ b/tests/FSharpPlus.1/General.fs @@ -211,7 +211,7 @@ type Monoid() = let quotLst123 = plus zero (ZipList [ [1];[2];[3] ]) Assert.AreEqual (quotLst123 |> toList, [[1]; [2]; [3]]) - Assert.AreEqual (SideEffects.get(), []) + Assert.AreEqual (list.Empty, SideEffects.get ()) let quotLst123' = Seq.sum [zero; zero; ZipList' [ [1];[2];[3] ]] @@ -245,7 +245,7 @@ type Functor() = Assert.IsInstanceOf>> (Some testVal3) // WrappedSeqD is Applicative. Applicatives are Functors => map should work - Assert.AreEqual (SideEffects.get(), []) + Assert.AreEqual (list.Empty, SideEffects.get ()) let testVal4 = map ((+) 1) (WrappedSeqD [1..3]) Assert.IsInstanceOf>> (Some testVal4) areEquivalent ["Using WrappedSeqD's Return"; "Using WrappedSeqD's Return"] (SideEffects.get()) @@ -256,7 +256,7 @@ type Functor() = Assert.IsInstanceOf>> (Some testVal5) // Same with WrappedListD but WrappedListD is also IEnumerable<_> - Assert.AreEqual (SideEffects.get(), []) + Assert.AreEqual (list.Empty, SideEffects.get ()) let testVal6 = map ((+) 1) (WrappedListD [1..3]) Assert.IsInstanceOf>> (Some testVal6) Assert.AreEqual (SideEffects.get(), ["Using WrappedListD's Bind"; "Using WrappedListD's Return"; "Using WrappedListD's Return"; "Using WrappedListD's Return"]) @@ -606,7 +606,7 @@ type Traversable() = Assert.AreEqual (None, a) Assert.AreEqual (None, b) Assert.True ((Choice2Of2 "This is a failure" = c)) - Assert.AreEqual ([], d) + areEquivalent Seq.empty d let resNone = traverse (fun x -> if x > 4 then Some x else None) (Seq.initInfinite id) // optimized method, otherwise it doesn't end () diff --git a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj index dfe2238a0..14f978890 100644 --- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj +++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj @@ -17,6 +17,10 @@ + + + + @@ -26,9 +30,6 @@ - - - @@ -46,11 +47,12 @@ - + + - - - - + + + + diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index 0d33480c0..e9a058ac7 100644 --- a/tests/FSharpPlus.Tests/General.fs +++ b/tests/FSharpPlus.Tests/General.fs @@ -262,24 +262,10 @@ type ReadOnlyListOnlyIndex<'s> (l: 's list) = member __.GetEnumerator () : IEnumerator<'s> = failwith "ReadOnlyListOnlyIndex.GetEnumerator" member __.GetEnumerator () : IEnumerator = failwith "ReadOnlyListOnlyIndex.GetEnumerator" -module Monoid = - - type ZipList<'s> = ZipList of 's seq with - static member Return (x:'a) = ZipList (Seq.initInfinite (konst x)) - static member Map (ZipList x, f: 'a->'b) = ZipList (Seq.map f x) - static member (<*>) (ZipList (f: seq<'a->'b>), ZipList x) = ZipList (Seq.zip f x |> Seq.map (fun (f,x) -> f x)) : ZipList<'b> - static member inline get_Zero () = result zero : ZipList<'a> - static member inline (+) (x:ZipList<'a>, y:ZipList<'a>) = lift2 plus x y :ZipList<'a> - static member ToSeq (ZipList lst) = lst - - type ZipList'<'s> = ZipList' of 's seq with - static member Return (x: 'a) = ZipList' (Seq.initInfinite (konst x)) - static member Map (ZipList' x, f: 'a->'b) = ZipList' (Seq.map f x) - static member (<*>) (ZipList' (f: seq<'a->'b>), ZipList' x) = ZipList' (Seq.zip f x |> Seq.map (fun (f,x) -> f x)) : ZipList'<'b> - static member inline get_Zero () = result zero : ZipList'<'a> - static member inline (+) (x: ZipList'<'a>, y: ZipList'<'a>) = lift2 plus x y :ZipList'<'a> - static member inline Sum (x: seq>) = SideEffects.add "Using optimized Sum"; List.foldBack plus (Seq.toList x) zero : ZipList'<'a> - static member ToSeq (ZipList' lst) = lst +module MonoidTestCompile = + open System.Collections + open System.Collections.Generic + open System.Threading.Tasks type MyList<'t> = MyList of list<'t> with static member get_Empty () = MyList [] @@ -340,40 +326,6 @@ module Monoid = () - [] - let seqSumDefaultCustom () = - let (WrappedListB x) = Seq.sum [WrappedListB [10]; WrappedListB [15]] - let (WrappedListC y) = Seq.sum [WrappedListC [10]; WrappedListC [15]] - Assert.AreEqual ([10;15], x) - Assert.AreEqual ([10], y) - - let x = [ ("a", 1); ("b", 2); ("a", 3) ] - let y = x |> map (Seq.singleton >> (ofSeq : seq<_*_> -> Dictionary<_,_>) >> map List.singleton) |> Seq.sum - let z = x |> map (Seq.singleton >> dict >> map List.singleton) |> Seq.sum - Assert.IsInstanceOf>> (Some y) - Assert.IsInstanceOf>> (Some z) - - SideEffects.reset () - - let quotLst123 = plus zero (ZipList [ [1];[2];[3] ]) - - Assert.AreEqual ([[1]; [2]; [3]], quotLst123 |> toList) - Assert.AreEqual ([], SideEffects.get ()) - - let quotLst123' = Seq.sum [zero; zero; ZipList' [ [1];[2];[3] ]] - - Assert.AreEqual ([[1]; [2]; [3]], quotLst123' |> toList) - Assert.AreEqual (["Using optimized Sum"], SideEffects.get ()) - - let _wl = WrappedListB [2..10] - - let _arrayGroup = groupBy ((%)/> 2) [|11;2;3;9;5;6;7;8;9;10|] - let _listGroup = groupBy ((%)/> 2) [ 11;2;3;9;5;6;7;8;9;10 ] - let _seqGroup = groupBy ((%)/> 2) (seq [11;2;3;9;5;6;7;8;9;10]) - - let _arrayGroupAdj = chunkBy ((%)/> 2) [11;2;3;9;5;6;7;8;9;10] - - () @@ -406,7 +358,7 @@ module Functor = Assert.IsInstanceOf>> (Some testVal6) // WrappedSeqD is Applicative. Applicatives are Functors => map should work - Assert.AreEqual ([], SideEffects.get ()) + Assert.AreEqual (list.Empty, SideEffects.get ()) let testVal4 = map ((+) 1) (WrappedSeqD [1..3]) Assert.IsInstanceOf>> (Some testVal4) Assert.AreEqual (["Using WrappedSeqD's Return"; "Using WrappedSeqD's Apply"], SideEffects.get ()) @@ -417,7 +369,7 @@ module Functor = Assert.IsInstanceOf>> (Some testVal5) // Same with WrappedListD but WrappedListD is also IEnumerable<_> - Assert.AreEqual ([], SideEffects.get ()) + Assert.AreEqual (list.Empty, SideEffects.get ()) let testVal6 = map ((+) 1) (WrappedListD [1..3]) Assert.IsInstanceOf>> (Some testVal6) Assert.AreEqual (["Using WrappedListD's Bind"; "Using WrappedListD's Return"; "Using WrappedListD's Return"; "Using WrappedListD's Return"], SideEffects.get ()) @@ -449,7 +401,7 @@ module Functor = SideEffects.reset () let _a = zip (seq [1;2;3]) (seq [1. .. 3. ]) - Assert.AreEqual ([], SideEffects.get ()) + Assert.AreEqual (list.Empty, SideEffects.get ()) let _b = zip (WrappedListD [1;2;3]) (WrappedListD [1. .. 3. ]) Assert.AreEqual (["Using WrappedListD's zip"], SideEffects.get ()) @@ -751,7 +703,7 @@ module Foldable = SideEffects.reset () let _ = foldMap ((+) 10) {1..4} //= 50 w/o side effect Assert.AreEqual (50, x) - Assert.AreEqual ([], SideEffects.get ()) + Assert.AreEqual (list.Empty, SideEffects.get ()) [] let filterDefaultCustom () = @@ -1203,300 +1155,6 @@ module Monad = #endif -module Traversable = - - type Either<'l,'r> = Left of 'l | Right of 'r with - static member Return x = Right x - static member inline get_Empty () = Left empty - static member Map (x, f) = match x with Right a -> Right (f a) | Left a -> Left a - static member (<*>) (f, x) = - SideEffects.add ("f(x) <*> " + string x) - match f, x with Right a, Right b -> Right (a b) | Left e, _ | _, Left e -> Left e - static member IsLeftZero x = match x with Left _ -> true | _ -> false - - let traverseTest = - let _None = sequence (seq [Some 3;None ;Some 1]) - let _None2 = sequence (TestNonEmptyCollection.Create (Some 42)) - () - - [] - let sequence_Default_Primitive () = - let testVal = sequence [|Some 1; Some 2|] - Assert.AreEqual (Some [|1;2|], testVal) - Assert.IsInstanceOf>> testVal - - [] - let traverseDerivedFromSequence () = - let testVal = traverse (fun x -> [int16 x..int16 (x+2)]) (WrappedListH [1; 4]) - Assert.AreEqual ( - [ - WrappedListH [1s; 4s]; WrappedListH [1s; 5s]; WrappedListH [1s; 6s]; - WrappedListH [2s; 4s]; WrappedListH [2s; 5s]; WrappedListH [2s; 6s]; - WrappedListH [3s; 4s]; WrappedListH [3s; 5s]; WrappedListH [3s; 6s] - ] , testVal) - Assert.IsInstanceOf>> testVal - - [] - let sequence_Specialization () = - - let inline seqSeq (x:_ seq ) = sequence x - let inline seqArr (x:_ [] ) = sequence x - let inline seqLst (x:_ list) = sequence x - - let a : list<_> = seqSeq (seq [[1];[3]]) - CollectionAssert.AreEqual ([seq [1; 3]], a) - Assert.IsInstanceOf>> a - let b = seqArr ( [|[1];[3]|]) - CollectionAssert.AreEqual ([[|1; 3|]], b) - Assert.IsInstanceOf>> b - let c = seqLst ( [ [1];[3] ]) - CollectionAssert.AreEqual ([[1; 3]], c) - Assert.IsInstanceOf>> c - - [] - let traverse_Specialization () = - let _ = Seq.traverse id [WrappedSeqD [1]; WrappedSeqD [2]] - let _ = Seq.sequence [WrappedSeqD [1]; WrappedSeqD [2]] - let _ = Seq.traverse id [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList - let _ = Seq.sequence [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList - () - - [] - let traverse_Order () = - SideEffects.reset() - let mapper v = SideEffects.add <| sprintf "mapping %d" v - let _ = traverse (Option.map mapper) [Some 1; Some 2] - SideEffects.are ["mapping 1"; "mapping 2"] - - - [] - let traversableForNonPrimitive () = - let nel = nelist { Some 1 } - let rs1 = traverse id nel - Assert.IsInstanceOf>> rs1 - let rs2 = sequence nel - Assert.IsInstanceOf>> rs2 - let nem = NonEmptyMap.Create (("a", Some 1), ("b", Some 2), ("c", Some 3)) - let rs3 = traverse id nem - Assert.IsInstanceOf>> rs3 - let rs4 = sequence nem - Assert.IsInstanceOf>> rs4 - let rs5 = traverse id (TestNonEmptyCollection.Create (Some 42)) - Assert.IsInstanceOf>> rs5 - let nes = neseq { Some 1 } - let rs6 = traverse id nes - Assert.IsInstanceOf>> rs6 - let rs7 = sequence nes - Assert.IsInstanceOf>> rs7 - - let toOptions x = if x <> 4 then Some x else None - let toChoices x = if x <> 4 then Choice1Of2 x else Choice2Of2 "This is a failure" - let toLists x = if x <> 4 then [x; x] else [] - let toEithers x = - if x > 4 then failwithf "Shouldn't be mapping for %i" x - if x = 4 then Left ["This is a failure"] else Right x - - let expectedEffects = - [ - """f(x) <*> Right 0""" - """f(x) <*> Right 1""" - """f(x) <*> Right 2""" - """f(x) <*> Right 3""" - """f(x) <*> Left ["This is a failure"]""" - ] - - [] - let traverseInfiniteApplicatives () = - - SideEffects.reset () - - let a = sequence (Seq.initInfinite toOptions) - let b = sequence (Seq.initInfinite toOptions) - let c = sequence (Seq.initInfinite toChoices) - let d = sequence (Seq.initInfinite toLists) - let e = sequence (Seq.initInfinite toEithers) - - CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) - SideEffects.reset () - - let _a = traverse toOptions (Seq.initInfinite id) - let _b = traverse toOptions (Seq.initInfinite id) - let _c = traverse toChoices (Seq.initInfinite id) - let _d = traverse toLists (Seq.initInfinite id) - let _e = traverse toEithers (Seq.initInfinite id) - - CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) - Assert.AreEqual (None, a) - Assert.AreEqual (None, b) - Assert.AreEqual (Choice,string>.Choice2Of2 "This is a failure", c) - Assert.AreEqual ([], d) - Assert.AreEqual (Either>.Left ["This is a failure"], e) - - SideEffects.reset () - - let a = sequence (NonEmptySeq.initInfinite toOptions) - let b = sequence (NonEmptySeq.initInfinite toOptions) - let c = sequence (NonEmptySeq.initInfinite toChoices) - let d = sequence (NonEmptySeq.initInfinite toLists) - let e = sequence (NonEmptySeq.initInfinite toEithers) - - CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) - SideEffects.reset () - - let _a = traverse toOptions (NonEmptySeq.initInfinite id) - let _b = traverse toOptions (NonEmptySeq.initInfinite id) - let _c = traverse toChoices (NonEmptySeq.initInfinite id) - let _d = traverse toLists (NonEmptySeq.initInfinite id) - let _e = traverse toEithers (NonEmptySeq.initInfinite id) - - CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) - Assert.AreEqual (None, a) - Assert.AreEqual (None, b) - Assert.AreEqual (Choice,string>.Choice2Of2 "This is a failure", c) - Assert.AreEqual ([], d) - Assert.AreEqual (Either>.Left ["This is a failure"], e) - - - let toEithersStrict x = - if x = 4 then Left ["This is a failure"] else Right x - - [] - let traverseFiniteApplicatives () = - - SideEffects.reset () - - let a = sequence (Seq.initInfinite toOptions |> Seq.take 20 |> Seq.toList) - let b = sequence (Seq.initInfinite toOptions |> Seq.take 20 |> Seq.toList) - let c = sequence (Seq.initInfinite toChoices |> Seq.take 20 |> Seq.toList) - let d = sequence (Seq.initInfinite toLists |> Seq.take 20 |> Seq.toList) - let e = sequence (Seq.initInfinite toEithersStrict |> Seq.take 20 |> Seq.toList) - - CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) - SideEffects.reset () - - let f = sequence (Seq.initInfinite toEithersStrict |> Seq.take 20 |> Seq.toArray) - - CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) - SideEffects.reset () - - let _a = traverse toOptions [1..20] - let _b = traverse toOptions [1..20] - let _c = traverse toChoices [1..20] - let _d = traverse toLists [1..20] - let _e = traverse toEithersStrict [1..20] - - CollectionAssert.AreNotEqual (expectedEffects, SideEffects.get ()) - SideEffects.reset () - - let _f = traverse toEithersStrict [|1..20|] - - CollectionAssert.AreNotEqual (expectedEffects, SideEffects.get ()) - Assert.AreEqual (None, a) - Assert.AreEqual (None, b) - Assert.AreEqual (Choice,string>.Choice2Of2 "This is a failure", c) - Assert.AreEqual ([], d) - Assert.AreEqual (Either>.Left ["This is a failure"], e) - Assert.AreEqual (Either>.Left ["This is a failure"], f) - () - - [] - let traverseAsyncSequences = - SideEffects.reset () - - let doSomething v = - SideEffects.add (sprintf "doSomething: %A" v) - sprintf "some: %A" v - |> async.Return - - seq [1..10] - |> traverse doSomething - |> map (head >> printfn "%A") - |> Async.RunSynchronously - CollectionAssert.AreEqual (["doSomething: 1"], SideEffects.get ()) - - SideEffects.reset () - NonEmptySeq.create 1 [2..10] - |> traverse doSomething - |> map (head >> printfn "%A") - |> Async.RunSynchronously - CollectionAssert.AreEqual (["doSomething: 1"], SideEffects.get ()) - - [] - let traverseInfiniteAsyncSequences = - let s = Seq.initInfinite async.Return - let s' = sequence s - let l = s' |> Async.RunSynchronously |> Seq.take 10 |> Seq.toList - CollectionAssert.AreEqual ([0;1;2;3;4;5;6;7;8;9], l) - - [] - let traverseTask () = - let a = traverse Task.FromResult [1;2] - CollectionAssert.AreEqual ([1;2], a.Result) - Assert.IsInstanceOf>> (Some a.Result) - let b = map Task.FromResult [1;2] |> sequence - CollectionAssert.AreEqual ([1;2], b.Result) - Assert.IsInstanceOf>> (Some b.Result) - let c = traverse Task.FromResult [|1;2|] - CollectionAssert.AreEqual ([|1;2|], c.Result) - Assert.IsInstanceOf>> (Some c.Result) - let d = map Task.FromResult [|1;2|] |> sequence - CollectionAssert.AreEqual ([|1;2|], d.Result) - Assert.IsInstanceOf>> (Some d.Result) - - [] - let traverseMap () = - let m = Map.ofList [("a", 1); ("b", 2); ("c", 3)] - let r1 = traverse (fun i -> if i = 2 then None else Some i) m - let r2 = traverse Some m - Assert.AreEqual(None, r1) - CollectionAssert.AreEqual (r2.Value, m) - - let m1 = Map.ofList [(1, [1;1;1]); (2, [2;2;2])] - let r1 = m1 |> traversei (fun _ _ -> None) - let r2 = m1 |> traversei (fun i v -> if List.forall ((=) i) v then Some (i :: v) else None) - Assert.AreEqual(None, r1) - CollectionAssert.AreEqual (Map.ofList [(1, [1;1;1;1]); (2, [2;2;2;2])], r2.Value) - - let expected = [Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; - Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; - Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]] - let actual = sequence m1 - CollectionAssert.AreEqual (expected, actual) - - [] - let traverseResults () = - let a = sequence (if true then Ok [1] else Error "no") - let b = traverse id (if true then Ok [1] else Error "no") - let expected: Result list = [Ok 1] - CollectionAssert.AreEqual (expected, a) - CollectionAssert.AreEqual (expected, b) - - -module Bitraversable = - - type Either<'left,'right> = Left of 'left | Right of 'right with - static member Bimap (x, f, g) = match x with Right a -> Right (f a) | Left e -> Left (g e) - static member inline Bisequence x = match x with Right a -> map Either<'Left,'Right>.Right a | Left e -> map Either<'Left,'Right>.Left e - - let _ErrorBad: Result list = bitraverse id id (Error ["Bad"]) - let _FailureBad: Validation list = bitraverse id id (Failure ["Bad"]) - let _Some42x = bitraverse (Option.map string) Some (Some 42, 'x') - let _LeftBad: Either list = bitraverse id id (Left ["Bad"]) // works through Bisequence and Bimap - - type Either2<'left,'right> = Left of 'left | Right of 'right with - static member inline Bitraverse (x, f, g) = match x with | Right a -> Either2<'Error2,'T2>.Right g a | Left e -> Either2<'Error2,'T2>.Left f e - - let _Right42: Either2 list = bisequence (Right [42]) // works through Bitraverse - - let c: Const = Const [1] - let d: Const<_, bool> = Const 2 - let e: Const<_, bool> = Const 3 - - let _Const1 = bisequence c - let _Const2 = bitraverse List.singleton List.singleton d - let _Const3 = bitraverse NonEmptyList.singleton NonEmptyList.singleton e - - () @@ -2048,153 +1706,10 @@ module Numerics = -type Sum<'a> = Sum of 'a with - static member inline get_Zero () = Sum 0G - static member inline (+) (Sum (x:'n), Sum (y:'n)) = Sum (x + y) - -module Splits = - [] - let splitArraysAndStrings () = - let a1 = "this.isABa.tABCest" |> split [|"AT" ; "ABC" |] - let a2 = "this.isABa.tABCest"B |> split [|"AT"B; "ABC"B|] |> Seq.map System.Text.Encoding.ASCII.GetString - - let b1 = "this.is.a.t...est" |> split [|"." ; "..." |] - let b2 = "this.is.a.t...est"B |> split [|"."B; "..."B|] |> Seq.map System.Text.Encoding.ASCII.GetString - - Assert.IsTrue((toList a1 = toList a2)) - Assert.IsTrue((toList b1 = toList b2)) - Assert.IsInstanceOf> (Some a1) - - [] - let replaceArraysAndStrings () = - let a1 = "this.isABa.tABCest" |> replace "AT" "ABC" - let a2 = "this.isABa.tABCest"B |> replace "AT"B "ABC"B |> System.Text.Encoding.ASCII.GetString - - let b1 = "this.is.a.t...est" |> replace "." "..." - let b2 = "this.is.a.t...est"B |> replace "."B "..."B |> System.Text.Encoding.ASCII.GetString - - Assert.IsTrue ((a1 = a2)) - Assert.IsTrue ((b1 = b2)) - - [] - let intercalateArraysAndStrings () = - let a1 = [|"this" ; "is" ; "a" ; "test" |] |> intercalate " " - let a2 = [|"this"B; "is"B; "a"B; "test"B|] |> intercalate " "B |> System.Text.Encoding.ASCII.GetString - - let b = [WrappedListB [1;2]; WrappedListB [3;4]; WrappedListB [6;7]] |> intercalate (WrappedListB [0;1]) - - let _c = [| Sum 1; Sum 2 |] |> intercalate (Sum 10) - let d = WrappedListB [Sum 1; Sum 2] |> intercalate (Sum 10) - let _e = intercalate 10 (seq [1; 2; 3]) - - Assert.IsTrue((a1 = a2)) - Assert.IsTrue((b = WrappedListB [1; 2; 0; 1; 3; 4; 0; 1; 6; 7])) - // Assert.IsTrue((c = Sum 13)) - Assert.IsTrue((d = Sum 13)) - - -module Parsing = - let (|Int32|_|) : _-> Int32 option = tryParse - type ProductId = { Value:int } - with - static member TryParse(value:string) : ProductId option= - match value.Split('_') |> List.ofArray with - | "P" :: Int32 v :: [] -> Some { Value = v } - | _ -> None - - [] - let parseDateTime () = -#if MONO - let v1 : DateTime = parse "2011-03-04T15:42:19+03:00" - Assert.IsTrue((v1 = DateTime(2011,3,4,12,42,19))) -#else - Assert.Ignore ("Depends on how it's executed...") -#endif - [] - let parse () = - let v2 : DateTimeOffset = parse "2011-03-04T15:42:19+03:00" - - Assert.IsTrue((v2 = DateTimeOffset(2011,3,4,15,42,19, TimeSpan.FromHours 3.))) - - let _101 = tryParse "10.1.0.1" : Net.IPAddress option - let _102 = tryParse "102" : string option - let _MTS = [tryParse "Monday" ; Some DayOfWeek.Thursday; Some DayOfWeek.Saturday] - let _103 = tryParse "103" : Text.StringBuilder option - - let _109 = parse "10.0.9.1" : Net.IPAddress - let _111 = parse "true" && true - let _MTF = [parse "Monday" ; DayOfWeek.Thursday; DayOfWeek.Friday] - let _110 = parse "10" + ofBytes [|10uy;0uy;0uy;0uy;0uy;0uy;0uy;0uy|] + 100. - let _120 = parse "10" + ofBytes [|10uy;0uy;0uy;0uy;|] + 100 - let _121 = parse "121" : string - let _122 = parse "122" : Text.StringBuilder - - let r66: float option = tryParse "66.0" - areStEqual r66 (Some 66.0) - let r123: WrappedListA option = tryParse "[1;2;3]" - areStEqual r123 (Some (WrappedListA [1; 2; 3])) - [] - let parseCustomType () = - let v1 : CustomerId option = tryParse "C_1" - Assert.IsTrue((v1.Value.Value = 1L)) - let v2 : CustomerId option = tryParse "C_X" - Assert.IsTrue(Option.isNone v2) - let v3 : ProductId option = tryParse "P_1" - Assert.IsTrue((v3.Value.Value = 1)) - let v4 : ProductId option = tryParse "P_X" - Assert.IsTrue(Option.isNone v4) -#if NETSTANDARD3_0 - let v5 : ICustomerId option = tryParse "C_1" - Assert.IsTrue((v5.Value.Value = 1L)) - let v6 : ICustomerId option = tryParse "C_X" - Assert.IsTrue(Option.isNone v6) -#endif - - [] - let scanfParsing () = - let _ccx: int * uint32 * float * float32 * int * uint32 * float * float32 * int * uint32 * float * float32 * int * uint32 * float * float32 * int = parseArray [|"34"; "24"; "34"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "11"; "12"; "13"; "14"; "15"; "16"; "17"|] - - let _t = sscanf "(%i-%i-%f-%i-%i-%i-%i-%i-%i)" "(32-66-888-4-5-6-7-8-9)" - let (_a,_b) = sscanf "(%%%s,%M)" "(%hello, 4.53)" - let (_x,_y,_z) = sscanf "%s-%s-%s" "test-this-string" - let (_j,_k,_l,_m,_n,_o,_p) = sscanf "%f %F %g %G %e %E %c" "1 2.1 3.4 .3 43.2e32 0 f" - - let (_r1,_r2,_r3,_r4,_r5,_r6,_r7,_r8) = sscanf "%f %F %g %G %e %E %c %c" "1 2.1 3.4 .3 43.2e32 0 f f" - let (_s1,_s2,_s3,_s4,_s5,_s6,_s7,_s8,_s9) = sscanf "%f %F %g %G %e %E %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f" - let (_t1,_t2,_t3,_t4,_t5,_t6,_t7,_t8,_t9,_t10) = sscanf "%f %F %g %G %e %E %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f" - let (_u1,_u2,_u3,_u4,_u5,_u6,_u7,_u8,_u9,_u10,_u11,_u12,_u13,_u14,_u15) = sscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f" - let (_v1,_v2,_v3,_v4,_v5,_v6,_v7,_v8,_v9,_v10,_v11,_v12,_v13,_v14,_v15,_v16) = sscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16" - let (_w1,_w2,_w3,_w4,_w5,_w6,_w7,_w8,_w9,_w10,_w11,_w12,_w13,_w14,_w15,_w16,_w17) = sscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i %f" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16 17" - - - let _zzz = sscanf "(%%%s)" "(%hello)" - let (_x1,_y1,_z1) = sscanf "%s--%s-%s" "test--this-string" - - - let _f1 = trySscanf "(%%%s)" "(%hello)" - let _f2 = trySscanf "%s--%s-%s" "test--this-gg" - let _f3 = trySscanf "%f %F %g %G %e %E %c %c" "1 2.1 3.4 .3 43.2e32 0 f f" - let _f4 = trySscanf "%f %F %g %G %e %E %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f" - let _f5 = trySscanf "%f %F %g %G %e %E %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f" - let _f6 = trySscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f" - let _f7 = trySscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16" - let _f8 = trySscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i %f" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16 17" - - let _date: (DayOfWeek * string * uint16 * int) option = trySscanf "%A %A %A %A" "Saturday March 25 1989" - - let x = trySscanf "%X %x" "13 43" - let o = trySscanf "%o" "10" - let b = trySscanf (PrintfFormat string, unit, string, string, int> "%B") "101" - let a = trySscanf (PrintfFormat int -> int -> int -> string, unit, string, string, int * int * int * int> "%B %o %x %X") "100 100 100 100" - - areEqual (Some (19, 67)) x - areEqual (Some 8) o - areEqual (Some 5) b - areEqual (Some (4, 64, 256, 256)) a module Conversions = let test = diff --git a/tests/FSharpPlus.Tests/Monoid.fs b/tests/FSharpPlus.Tests/Monoid.fs new file mode 100644 index 000000000..b8c520f0d --- /dev/null +++ b/tests/FSharpPlus.Tests/Monoid.fs @@ -0,0 +1,68 @@ +namespace FSharpPlus.Tests + +open System +open System.Collections.ObjectModel +open FSharpPlus +open FSharpPlus.Data +open FSharpPlus.Control +open NUnit.Framework +open Helpers +open CSharpLib + +module Monoid = + open System.Collections + open System.Collections.Generic + + type ZipList<'s> = ZipList of 's seq with + static member Return (x:'a) = ZipList (Seq.initInfinite (konst x)) + static member Map (ZipList x, f: 'a->'b) = ZipList (Seq.map f x) + static member (<*>) (ZipList (f: seq<'a->'b>), ZipList x) = ZipList (Seq.zip f x |> Seq.map (fun (f,x) -> f x)) : ZipList<'b> + static member inline get_Zero () = result zero : ZipList<'a> + static member inline (+) (x:ZipList<'a>, y:ZipList<'a>) = lift2 plus x y :ZipList<'a> + static member ToSeq (ZipList lst) = lst + + type ZipList'<'s> = ZipList' of 's seq with + static member Return (x: 'a) = ZipList' (Seq.initInfinite (konst x)) + static member Map (ZipList' x, f: 'a->'b) = ZipList' (Seq.map f x) + static member (<*>) (ZipList' (f: seq<'a->'b>), ZipList' x) = ZipList' (Seq.zip f x |> Seq.map (fun (f,x) -> f x)) : ZipList'<'b> + static member inline get_Zero () = result zero : ZipList'<'a> + static member inline (+) (x: ZipList'<'a>, y: ZipList'<'a>) = lift2 plus x y :ZipList'<'a> + static member inline Sum (x: seq>) = SideEffects.add "Using optimized Sum"; List.foldBack plus (Seq.toList x) zero : ZipList'<'a> + static member ToSeq (ZipList' lst) = lst + + + [] + let seqSumDefaultCustom () = + + let (WrappedListB x) = Seq.sum [WrappedListB [10]; WrappedListB [15]] + let (WrappedListC y) = Seq.sum [WrappedListC [10]; WrappedListC [15]] + Assert.AreEqual ([10;15], x) + Assert.AreEqual ([10], y) + + let x = [ ("a", 1); ("b", 2); ("a", 3) ] + let y = x |> map (Seq.singleton >> (ofSeq : seq<_*_> -> Dictionary<_,_>) >> map List.singleton) |> Seq.sum + let z = x |> map (Seq.singleton >> dict >> map List.singleton) |> Seq.sum + Assert.IsInstanceOf>> (Some y) + Assert.IsInstanceOf>> (Some z) + + SideEffects.reset () + + let quotLst123 = plus zero (ZipList [ [1];[2];[3] ]) + + Assert.AreEqual ([[1]; [2]; [3]], quotLst123 |> toList) + Assert.AreEqual (list.Empty, SideEffects.get ()) + + let quotLst123' = Seq.sum [zero; zero; ZipList' [ [1];[2];[3] ]] + + Assert.AreEqual ([[1]; [2]; [3]], quotLst123' |> toList) + Assert.AreEqual (["Using optimized Sum"], SideEffects.get ()) + + let _wl = WrappedListB [2..10] + + let _arrayGroup = groupBy ((%)/> 2) [|11;2;3;9;5;6;7;8;9;10|] + let _listGroup = groupBy ((%)/> 2) [ 11;2;3;9;5;6;7;8;9;10 ] + let _seqGroup = groupBy ((%)/> 2) (seq [11;2;3;9;5;6;7;8;9;10]) + + let _arrayGroupAdj = chunkBy ((%)/> 2) [11;2;3;9;5;6;7;8;9;10] + + () \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Parsing.fs b/tests/FSharpPlus.Tests/Parsing.fs new file mode 100644 index 000000000..34e604dba --- /dev/null +++ b/tests/FSharpPlus.Tests/Parsing.fs @@ -0,0 +1,112 @@ +namespace FSharpPlus.Tests + +open System +open System.Collections.ObjectModel +open FSharpPlus +open FSharpPlus.Data +open FSharpPlus.Control +open NUnit.Framework +open Helpers +open CSharpLib + +module Parsing = + let (|Int32|_|) : _-> Int32 option = tryParse + type ProductId = { Value:int } + with + static member TryParse(value:string) : ProductId option = + match value.Split('_') |> List.ofArray with + | "P" :: Int32 v :: [] -> Some { Value = v } + | _ -> None + + [] + let parseDateTime () = +#if MONO + let v1 : DateTime = parse "2011-03-04T15:42:19+03:00" + Assert.IsTrue((v1 = DateTime(2011,3,4,12,42,19))) +#else + Assert.Ignore ("Depends on how it's executed...") +#endif + + [] + let parse () = + let v2 : DateTimeOffset = parse "2011-03-04T15:42:19+03:00" + + Assert.IsTrue((v2 = DateTimeOffset(2011,3,4,15,42,19, TimeSpan.FromHours 3.))) + + let _101 = tryParse "10.1.0.1" : Net.IPAddress option + let _102 = tryParse "102" : string option + let _MTS = [tryParse "Monday" ; Some DayOfWeek.Thursday; Some DayOfWeek.Saturday] + let _103 = tryParse "103" : Text.StringBuilder option + + let _109 = parse "10.0.9.1" : Net.IPAddress + let _111 = parse "true" && true + let _MTF = [parse "Monday" ; DayOfWeek.Thursday; DayOfWeek.Friday] + let _110 = parse "10" + ofBytes [|10uy;0uy;0uy;0uy;0uy;0uy;0uy;0uy|] + 100. + let _120 = parse "10" + ofBytes [|10uy;0uy;0uy;0uy;|] + 100 + let _121 = parse "121" : string + let _122 = parse "122" : Text.StringBuilder + + let r66: float option = tryParse "66.0" + areStEqual r66 (Some 66.0) + + let r123: WrappedListA option = tryParse "[1;2;3]" + areStEqual r123 (Some (WrappedListA [1; 2; 3])) + + [] + let parseCustomType () = + let v1 : CustomerId option = tryParse "C_1" + Assert.IsTrue((v1.Value.Value = 1L)) + let v2 : CustomerId option = tryParse "C_X" + Assert.IsTrue(Option.isNone v2) + let v3 : ProductId option = tryParse "P_1" + Assert.IsTrue((v3.Value.Value = 1)) + let v4 : ProductId option = tryParse "P_X" + Assert.IsTrue(Option.isNone v4) +#if NETSTANDARD3_0 + let v5 : ICustomerId option = tryParse "C_1" + Assert.IsTrue((v5.Value.Value = 1L)) + let v6 : ICustomerId option = tryParse "C_X" + Assert.IsTrue(Option.isNone v6) +#endif + + [] + let scanfParsing () = + let _ccx: int * uint32 * float * float32 * int * uint32 * float * float32 * int * uint32 * float * float32 * int * uint32 * float * float32 * int = parseArray [|"34"; "24"; "34"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; "11"; "12"; "13"; "14"; "15"; "16"; "17"|] + + let _t = sscanf "(%i-%i-%f-%i-%i-%i-%i-%i-%i)" "(32-66-888-4-5-6-7-8-9)" + let (_a,_b) = sscanf "(%%%s,%M)" "(%hello, 4.53)" + let (_x,_y,_z) = sscanf "%s-%s-%s" "test-this-string" + let (_j,_k,_l,_m,_n,_o,_p) = sscanf "%f %F %g %G %e %E %c" "1 2.1 3.4 .3 43.2e32 0 f" + + let (_r1,_r2,_r3,_r4,_r5,_r6,_r7,_r8) = sscanf "%f %F %g %G %e %E %c %c" "1 2.1 3.4 .3 43.2e32 0 f f" + let (_s1,_s2,_s3,_s4,_s5,_s6,_s7,_s8,_s9) = sscanf "%f %F %g %G %e %E %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f" + let (_t1,_t2,_t3,_t4,_t5,_t6,_t7,_t8,_t9,_t10) = sscanf "%f %F %g %G %e %E %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f" + let (_u1,_u2,_u3,_u4,_u5,_u6,_u7,_u8,_u9,_u10,_u11,_u12,_u13,_u14,_u15) = sscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f" + let (_v1,_v2,_v3,_v4,_v5,_v6,_v7,_v8,_v9,_v10,_v11,_v12,_v13,_v14,_v15,_v16) = sscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16" + let (_w1,_w2,_w3,_w4,_w5,_w6,_w7,_w8,_w9,_w10,_w11,_w12,_w13,_w14,_w15,_w16,_w17) = sscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i %f" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16 17" + + + let _zzz = sscanf "(%%%s)" "(%hello)" + let (_x1,_y1,_z1) = sscanf "%s--%s-%s" "test--this-string" + + + let _f1 = trySscanf "(%%%s)" "(%hello)" + let _f2 = trySscanf "%s--%s-%s" "test--this-gg" + let _f3 = trySscanf "%f %F %g %G %e %E %c %c" "1 2.1 3.4 .3 43.2e32 0 f f" + let _f4 = trySscanf "%f %F %g %G %e %E %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f" + let _f5 = trySscanf "%f %F %g %G %e %E %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f" + let _f6 = trySscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f" + let _f7 = trySscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16" + let _f8 = trySscanf "%f %F %g %G %e %E %c %c %c %c %c %c %c %c %c %i %f" "1 2.1 3.4 .3 43.2e32 0 f f f f f f f f f 16 17" + + let _date: (DayOfWeek * string * uint16 * int) option = trySscanf "%A %A %A %A" "Saturday March 25 1989" + + let x = trySscanf "%X %x" "13 43" + let o = trySscanf "%o" "10" + let b = trySscanf (PrintfFormat string, unit, string, string, int> "%B") "101" + let a = trySscanf (PrintfFormat int -> int -> int -> string, unit, string, string, int * int * int * int> "%B %o %x %X") "100 100 100 100" + + areEqual (Some (19, 67)) x + areEqual (Some 8) o + areEqual (Some 5) b + areEqual (Some (4, 64, 256, 256)) a \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Splits.fs b/tests/FSharpPlus.Tests/Splits.fs new file mode 100644 index 000000000..86c3d0f24 --- /dev/null +++ b/tests/FSharpPlus.Tests/Splits.fs @@ -0,0 +1,55 @@ +namespace FSharpPlus.Tests + +open System +open System.Collections.ObjectModel +open FSharpPlus +open FSharpPlus.Data +open FSharpPlus.Control +open NUnit.Framework +open Helpers +open CSharpLib + + +type Sum<'a> = Sum of 'a with + static member inline get_Zero () = Sum 0G + static member inline (+) (Sum (x:'n), Sum (y:'n)) = Sum (x + y) + +module Splits = + [] + let splitArraysAndStrings () = + let a1 = "this.isABa.tABCest" |> split [|"AT" ; "ABC" |] + let a2 = "this.isABa.tABCest"B |> split [|"AT"B; "ABC"B|] |> Seq.map System.Text.Encoding.ASCII.GetString + + let b1 = "this.is.a.t...est" |> split [|"." ; "..." |] + let b2 = "this.is.a.t...est"B |> split [|"."B; "..."B|] |> Seq.map System.Text.Encoding.ASCII.GetString + + Assert.IsTrue((toList a1 = toList a2)) + Assert.IsTrue((toList b1 = toList b2)) + Assert.IsInstanceOf> (Some a1) + + [] + let replaceArraysAndStrings () = + let a1 = "this.isABa.tABCest" |> replace "AT" "ABC" + let a2 = "this.isABa.tABCest"B |> replace "AT"B "ABC"B |> System.Text.Encoding.ASCII.GetString + + let b1 = "this.is.a.t...est" |> replace "." "..." + let b2 = "this.is.a.t...est"B |> replace "."B "..."B |> System.Text.Encoding.ASCII.GetString + + Assert.IsTrue ((a1 = a2)) + Assert.IsTrue ((b1 = b2)) + + [] + let intercalateArraysAndStrings () = + let a1 = [|"this" ; "is" ; "a" ; "test" |] |> intercalate " " + let a2 = [|"this"B; "is"B; "a"B; "test"B|] |> intercalate " "B |> System.Text.Encoding.ASCII.GetString + + let b = [WrappedListB [1;2]; WrappedListB [3;4]; WrappedListB [6;7]] |> intercalate (WrappedListB [0;1]) + + let _c = [| Sum 1; Sum 2 |] |> intercalate (Sum 10) + let d = WrappedListB [Sum 1; Sum 2] |> intercalate (Sum 10) + let _e = intercalate 10 (seq [1; 2; 3]) + + Assert.IsTrue((a1 = a2)) + Assert.IsTrue((b = WrappedListB [1; 2; 0; 1; 3; 4; 0; 1; 6; 7])) + // Assert.IsTrue((c = Sum 13)) + Assert.IsTrue((d = Sum 13)) \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Traversals.fs b/tests/FSharpPlus.Tests/Traversals.fs new file mode 100644 index 000000000..bd216e4b5 --- /dev/null +++ b/tests/FSharpPlus.Tests/Traversals.fs @@ -0,0 +1,320 @@ +namespace FSharpPlus.Tests + +#nowarn "686" + +open System +open System.Collections.ObjectModel +open FSharpPlus +open FSharpPlus.Data +open FSharpPlus.Control +open NUnit.Framework +open Helpers +open FSharpPlus.Math.Applicative +open CSharpLib +open System.Threading.Tasks + +module Traversable = + + type Either<'l,'r> = Left of 'l | Right of 'r with + static member Return x = Right x + static member inline get_Empty () = Left empty + static member Map (x, f) = match x with Right a -> Right (f a) | Left a -> Left a + static member (<*>) (f, x) = + SideEffects.add ("f(x) <*> " + string x) + match f, x with Right a, Right b -> Right (a b) | Left e, _ | _, Left e -> Left e + static member IsLeftZero x = match x with Left _ -> true | _ -> false + + let traverseTest = + let _None = sequence (seq [Some 3;None ;Some 1]) + let _None2 = sequence (TestNonEmptyCollection.Create (Some 42)) + () + + [] + let sequence_Default_Primitive () = + let testVal = sequence [|Some 1; Some 2|] + Assert.AreEqual (Some [|1;2|], testVal) + Assert.IsInstanceOf>> testVal + + [] + let traverseDerivedFromSequence () = + let testVal = traverse (fun x -> [int16 x..int16 (x+2)]) (WrappedListH [1; 4]) + Assert.AreEqual ( + [ + WrappedListH [1s; 4s]; WrappedListH [1s; 5s]; WrappedListH [1s; 6s]; + WrappedListH [2s; 4s]; WrappedListH [2s; 5s]; WrappedListH [2s; 6s]; + WrappedListH [3s; 4s]; WrappedListH [3s; 5s]; WrappedListH [3s; 6s] + ] , testVal) + Assert.IsInstanceOf>> testVal + + [] + let sequence_Specialization () = + + let inline seqSeq (x:_ seq ) = sequence x + let inline seqArr (x:_ [] ) = sequence x + let inline seqLst (x:_ list) = sequence x + + let a : list<_> = seqSeq (seq [[1];[3]]) + CollectionAssert.AreEqual ([seq [1; 3]], a) + Assert.IsInstanceOf>> a + let b = seqArr ( [|[1];[3]|]) + CollectionAssert.AreEqual ([[|1; 3|]], b) + Assert.IsInstanceOf>> b + let c = seqLst ( [ [1];[3] ]) + CollectionAssert.AreEqual ([[1; 3]], c) + Assert.IsInstanceOf>> c + + [] + let traverse_Specialization () = + let _ = Seq.traverse id [WrappedSeqD [1]; WrappedSeqD [2]] + let _ = Seq.sequence [WrappedSeqD [1]; WrappedSeqD [2]] + let _ = Seq.traverse id [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList + let _ = Seq.sequence [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList + () + + [] + let traverse_Order () = + SideEffects.reset() + let mapper v = SideEffects.add <| sprintf "mapping %d" v + let _ = traverse (Option.map mapper) [Some 1; Some 2] + SideEffects.are ["mapping 1"; "mapping 2"] + + + [] + let traversableForNonPrimitive () = + let nel = nelist { Some 1 } + let rs1 = traverse id nel + Assert.IsInstanceOf>> rs1 + let rs2 = sequence nel + Assert.IsInstanceOf>> rs2 + let nem = NonEmptyMap.Create (("a", Some 1), ("b", Some 2), ("c", Some 3)) + let rs3 = traverse id nem + Assert.IsInstanceOf>> rs3 + let rs4 = sequence nem + Assert.IsInstanceOf>> rs4 + let rs5 = traverse id (TestNonEmptyCollection.Create (Some 42)) + Assert.IsInstanceOf>> rs5 + let nes = neseq { Some 1 } + let rs6 = traverse id nes + Assert.IsInstanceOf>> rs6 + let rs7 = sequence nes + Assert.IsInstanceOf>> rs7 + + let toOptions x = if x <> 4 then Some x else None + let toChoices x = if x <> 4 then Choice1Of2 x else Choice2Of2 "This is a failure" + let toLists x = if x <> 4 then [x; x] else [] + let toEithers x = + if x > 4 then failwithf "Shouldn't be mapping for %i" x + if x = 4 then Left ["This is a failure"] else Right x + + [] + let traverseInfiniteApplicatives () = + + // It hangs if we try to share this value between tests + let expectedEffects = + [ + """f(x) <*> Right 0""" + """f(x) <*> Right 1""" + """f(x) <*> Right 2""" + """f(x) <*> Right 3""" + """f(x) <*> Left ["This is a failure"]""" + ] + + SideEffects.reset () + + let a = sequence (Seq.initInfinite toOptions) + let b = sequence (Seq.initInfinite toOptions) + let c = sequence (Seq.initInfinite toChoices) + let d = sequence (Seq.initInfinite toLists) + let e = sequence (Seq.initInfinite toEithers) + + CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) + SideEffects.reset () + + let _a = traverse toOptions (Seq.initInfinite id) + let _b = traverse toOptions (Seq.initInfinite id) + let _c = traverse toChoices (Seq.initInfinite id) + let _d = traverse toLists (Seq.initInfinite id) + let _e = traverse toEithers (Seq.initInfinite id) + + CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) + Assert.AreEqual (None, a) + Assert.AreEqual (None, b) + Assert.AreEqual (Choice,string>.Choice2Of2 "This is a failure", c) + Assert.AreEqual (List.empty>, d) + Assert.AreEqual (Either>.Left ["This is a failure"], e) + + SideEffects.reset () + + let a = sequence (NonEmptySeq.initInfinite toOptions) + let b = sequence (NonEmptySeq.initInfinite toOptions) + let c = sequence (NonEmptySeq.initInfinite toChoices) + let d = sequence (NonEmptySeq.initInfinite toLists) + let e = sequence (NonEmptySeq.initInfinite toEithers) + + CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) + SideEffects.reset () + + let _a = traverse toOptions (NonEmptySeq.initInfinite id) + let _b = traverse toOptions (NonEmptySeq.initInfinite id) + let _c = traverse toChoices (NonEmptySeq.initInfinite id) + let _d = traverse toLists (NonEmptySeq.initInfinite id) + let _e = traverse toEithers (NonEmptySeq.initInfinite id) + + CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) + Assert.AreEqual (None, a) + Assert.AreEqual (None, b) + Assert.AreEqual (Choice,string>.Choice2Of2 "This is a failure", c) + Assert.True ((d = [])) + Assert.AreEqual (Either>.Left ["This is a failure"], e) + + + let toEithersStrict x = + if x = 4 then Left ["This is a failure"] else Right x + + [] + let traverseFiniteApplicatives () = + + // It hangs if we try to share this value between tests + let expectedEffects = + [ + """f(x) <*> Right 0""" + """f(x) <*> Right 1""" + """f(x) <*> Right 2""" + """f(x) <*> Right 3""" + """f(x) <*> Left ["This is a failure"]""" + ] + + SideEffects.reset () + + let a = sequence (Seq.initInfinite toOptions |> Seq.take 20 |> Seq.toList) + let b = sequence (Seq.initInfinite toOptions |> Seq.take 20 |> Seq.toList) + let c = sequence (Seq.initInfinite toChoices |> Seq.take 20 |> Seq.toList) + let d = sequence (Seq.initInfinite toLists |> Seq.take 20 |> Seq.toList) + let e = sequence (Seq.initInfinite toEithersStrict |> Seq.take 20 |> Seq.toList) + + CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) + SideEffects.reset () + + let f = sequence (Seq.initInfinite toEithersStrict |> Seq.take 20 |> Seq.toArray) + + CollectionAssert.AreEqual (expectedEffects, SideEffects.get ()) + SideEffects.reset () + + let _a = traverse toOptions [1..20] + let _b = traverse toOptions [1..20] + let _c = traverse toChoices [1..20] + let _d = traverse toLists [1..20] + let _e = traverse toEithersStrict [1..20] + + CollectionAssert.AreNotEqual (expectedEffects, SideEffects.get ()) + SideEffects.reset () + + let _f = traverse toEithersStrict [|1..20|] + + CollectionAssert.AreNotEqual (expectedEffects, SideEffects.get ()) + Assert.AreEqual (None, a) + Assert.AreEqual (None, b) + Assert.AreEqual (Choice,string>.Choice2Of2 "This is a failure", c) + Assert.AreEqual (List.empty>, d) + Assert.AreEqual (Either>.Left ["This is a failure"], e) + Assert.AreEqual (Either>.Left ["This is a failure"], f) + () + + [] + let traverseAsyncSequences = + SideEffects.reset () + + let doSomething v = + SideEffects.add (sprintf "doSomething: %A" v) + sprintf "some: %A" v + |> async.Return + + seq [1..10] + |> traverse doSomething + |> map (head >> printfn "%A") + |> Async.RunSynchronously + CollectionAssert.AreEqual (["doSomething: 1"], SideEffects.get ()) + + SideEffects.reset () + NonEmptySeq.create 1 [2..10] + |> traverse doSomething + |> map (head >> printfn "%A") + |> Async.RunSynchronously + CollectionAssert.AreEqual (["doSomething: 1"], SideEffects.get ()) + + [] + let traverseInfiniteAsyncSequences = + let s = Seq.initInfinite async.Return + let s' = sequence s + let l = s' |> Async.RunSynchronously |> Seq.take 10 |> Seq.toList + CollectionAssert.AreEqual ([0;1;2;3;4;5;6;7;8;9], l) + + [] + let traverseTask () = + let a = traverse Task.FromResult [1;2] + CollectionAssert.AreEqual ([1;2], a.Result) + Assert.IsInstanceOf>> (Some a.Result) + let b = map Task.FromResult [1;2] |> sequence + CollectionAssert.AreEqual ([1;2], b.Result) + Assert.IsInstanceOf>> (Some b.Result) + let c = traverse Task.FromResult [|1;2|] + CollectionAssert.AreEqual ([|1;2|], c.Result) + Assert.IsInstanceOf>> (Some c.Result) + let d = map Task.FromResult [|1;2|] |> sequence + CollectionAssert.AreEqual ([|1;2|], d.Result) + Assert.IsInstanceOf>> (Some d.Result) + + [] + let traverseMap () = + let m = Map.ofList [("a", 1); ("b", 2); ("c", 3)] + let r1 = traverse (fun i -> if i = 2 then None else Some i) m + let r2 = traverse Some m + Assert.AreEqual(None, r1) + CollectionAssert.AreEqual (r2.Value, m) + + let m1 = Map.ofList [(1, [1;1;1]); (2, [2;2;2])] + let r1 = m1 |> traversei (fun _ _ -> None) + let r2 = m1 |> traversei (fun i v -> if List.forall ((=) i) v then Some (i :: v) else None) + Assert.AreEqual(None, r1) + CollectionAssert.AreEqual (Map.ofList [(1, [1;1;1;1]); (2, [2;2;2;2])], r2.Value) + + let expected = [Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; + Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; + Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]; Map.ofList [(1, 1); (2, 2)]] + let actual = sequence m1 + CollectionAssert.AreEqual (expected, actual) + + [] + let traverseResults () = + let a = sequence (if true then Ok [1] else Error "no") + let b = traverse id (if true then Ok [1] else Error "no") + let expected: Result list = [Ok 1] + CollectionAssert.AreEqual (expected, a) + CollectionAssert.AreEqual (expected, b) + + +module Bitraversable = + + type Either<'left,'right> = Left of 'left | Right of 'right with + static member Bimap (x, f, g) = match x with Right a -> Right (f a) | Left e -> Left (g e) + static member inline Bisequence x = match x with Right a -> map Either<'Left,'Right>.Right a | Left e -> map Either<'Left,'Right>.Left e + + let _ErrorBad: Result list = bitraverse id id (Error ["Bad"]) + let _FailureBad: Validation list = bitraverse id id (Failure ["Bad"]) + let _Some42x = bitraverse (Option.map string) Some (Some 42, 'x') + let _LeftBad: Either list = bitraverse id id (Left ["Bad"]) // works through Bisequence and Bimap + + type Either2<'left,'right> = Left of 'left | Right of 'right with + static member inline Bitraverse (x, f, g) = match x with | Right a -> Either2<'Error2,'T2>.Right g a | Left e -> Either2<'Error2,'T2>.Left f e + + let _Right42: Either2 list = bisequence (Right [42]) // works through Bitraverse + + let c: Const = Const [1] + let d: Const<_, bool> = Const 2 + let e: Const<_, bool> = Const 3 + + let _Const1 = bisequence c + let _Const2 = bitraverse List.singleton List.singleton d + let _Const3 = bitraverse NonEmptyList.singleton NonEmptyList.singleton e + + () \ No newline at end of file diff --git a/tests/FSharpPlusFable.Tests/FSharpPlusFable.Tests.fsproj b/tests/FSharpPlusFable.Tests/FSharpPlusFable.Tests.fsproj index 5befa1f2b..2efcfc44c 100644 --- a/tests/FSharpPlusFable.Tests/FSharpPlusFable.Tests.fsproj +++ b/tests/FSharpPlusFable.Tests/FSharpPlusFable.Tests.fsproj @@ -1,4 +1,4 @@ - + Exe @@ -13,6 +13,8 @@ + + @@ -42,6 +44,6 @@ True - + diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs index cfe212478..fe7e0757f 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs @@ -205,68 +205,6 @@ let invariant = testList "Invariant" [ #endif ] -type Sum<'a> = Sum of 'a with - static member inline get_Zero () = Sum 0 - static member inline (+) (Sum (x:'n), Sum (y:'n)) = Sum (x + y) - - -let splits = testList "Splits" [ - - #if !FABLE_COMPILER || FABLE_COMPILER_3 - testCase "splitArraysAndStrings" (fun () -> - let a1 = "this.isABa.tABCest" |> split [|"AT" ; "ABC" |] - let a2 = "this.isABa.tABCest"B |> split [|"AT"B; "ABC"B|] - - let b1 = "this.is.a.t...est" |> split [|"." ; "..." |] - let b2 = "this.is.a.t...est"B |> split [|"."B; "..."B|] - - Assert.IsTrue ((toList a1 = ["this.isABa.t"; "est"])) - Assert.IsTrue ((toList a2 = [[|116uy; 104uy; 105uy; 115uy; 46uy; 105uy; 115uy; 65uy; 66uy; 97uy; 46uy; 116uy|]; [|101uy; 115uy; 116uy|]])) - Assert.IsTrue ((toList b1 = ["this"; "is"; "a"; "t"; ""; ""; "est"])) - Assert.IsTrue ((toList b2 = [[|116uy; 104uy; 105uy; 115uy|]; [|105uy; 115uy|]; [|97uy|]; [|116uy|]; [||]; [||]; [|101uy; 115uy; 116uy|]])) - - #if !FABLE_COMPILER - Assert.IsInstanceOf> (Some a1) - #endif - ) - - testCase "replaceArraysAndStrings" (fun () -> - let a1 = "this.isABa.tABCest" |> replace "AT" "ABC" - let a2 = "this.isABa.tABCest"B |> replace "AT"B "ABC"B - - let b1 = "this.is.a.t...est" |> replace "." "..." - let b2 = "this.is.a.t...est"B |> replace "."B "..."B - - Assert.IsTrue ((a1 = "this.isABa.tABCest")) - Assert.IsTrue ((a2 = [|116uy; 104uy; 105uy; 115uy; 46uy; 105uy; 115uy; 65uy; 66uy; 97uy; 46uy; 116uy; 65uy; 66uy; 67uy; 101uy; 115uy; 116uy|])) - Assert.IsTrue ((b1 = "this...is...a...t.........est")) - Assert.IsTrue ((b2 = [|116uy; 104uy; 105uy; 115uy; 46uy; 46uy; 46uy; 105uy; 115uy; 46uy; 46uy; 46uy; 97uy; 46uy; 46uy; 46uy; 116uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 101uy; 115uy; 116uy|])) - ) - - testCase "intercalateArraysAndStrings" (fun () -> - let a1 = [|"this" ; "is" ; "a" ; "test" |] |> intercalate " " - let a2 = [|"this"B; "is"B; "a"B; "test"B|] |> intercalate " "B - - //let b = [WrappedListB [1;2]; WrappedListB [3;4]; WrappedListB [6;7]] |> intercalate (WrappedListB [0;1]) - - // /Control/Monoid.fs(..): (..) error FABLE: Cannot resolve trait call + - Inline call from ./Collection.fs(..) < ../../../tests/FSharpPlusFable.Tests/FSharpTests/General.fs(..) - #if !FABLE_COMPILER - let _c = [| Sum 1; Sum 2 |] |> intercalate (Sum 10) - let d = WrappedListB [Sum 1; Sum 2] |> intercalate (Sum 10) - let _e = intercalate 10 (seq [1; 2; 3]) - #endif - - Assert.IsTrue((a1 = "this is a test")) - Assert.IsTrue((a2 = [|116uy; 104uy; 105uy; 115uy; 32uy; 105uy; 115uy; 32uy; 97uy; 32uy; 116uy; 101uy; 115uy; 116uy|])) - //Assert.IsTrue((b = WrappedListB [1; 2; 0; 1; 3; 4; 0; 1; 6; 7])) - // Assert.IsTrue((c = Sum 13)) - #if !FABLE_COMPILER - Assert.IsTrue((d = Sum 13)) - #endif - ) - #endif - - ] let bitConverter = testList "BitConverter" [ #if !FABLE_COMPILER @@ -420,8 +358,10 @@ open General.Foldable open General.Functor open General.Indexable open General.Monad +open General.MonoidCompile open General.Monoid open General.Parsing +open General.Splits open General.Traversable open General.Lensing open General.Numeric @@ -429,7 +369,6 @@ open General.Numeric let generalTests = testList "General" [ idiomBrackets monadTransformers - splits bitConverter curry memoization @@ -440,6 +379,7 @@ let generalTests = testList "General" [ functor indexable monad + // monoidCompile monoid parsing traversable diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/Monoid.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/Monoid.fs index cdea478c2..4013c845d 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General/Monoid.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/Monoid.fs @@ -38,72 +38,7 @@ type MyNum = MyNum of int with static member FromInt32 x = MyNum x -let testCompile = - #if !FABLE_COMPILER - - let _res1n2 = MyList [1] ++ MyList [2] ++ zero - let _res0 : MyNum = zero - let _asQuotation = plus <@ ResizeArray (["1"]) @> <@ ResizeArray (["2;3"]) @> - let _quot123 = plus <@ ResizeArray ([1]) @> <@ ResizeArray ([2;3]) @> - let _quot1 = plus <@ ResizeArray ([1]) @> (zero) - let _quot23 = plus (zero) <@ ResizeArray ([2;3]) @> - let _quot13 = plus (zero) <@ ("1","3") @> - #endif - #if !FABLE_COMPILER || FABLE_COMPILER_3 - let lzy1 = plus (lazy [1]) (lazy [2;3]) - #endif - #if !FABLE_COMPILER - let _lzy = plus (zero) lzy1 - #endif - #if !FABLE_COMPILER || FABLE_COMPILER_3 - let asy1 = plus (async.Return [1]) (async.Return [2;3]) - #endif - #if !FABLE_COMPILER - let _asy = plus (zero) asy1 - let _bigNestedTuple1 = (1, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ (2, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ (3, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) - let _bigNestedTuple2 = (1, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ (zero, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ zero - #endif - - #if !FABLE_COMPILER || FABLE_COMPILER_3 - let _nes : NonEmptySeq<_> = plus (NonEmptySeq.singleton 1) (NonEmptySeq.singleton 2) - #endif - - let mapA = Map.empty - |> Map.add 1 (async.Return "Hey") - |> Map.add 2 (async.Return "Hello") - - let mapB = Map.empty - |> Map.add 3 (async.Return " You") - |> Map.add 2 (async.Return " World") - - #if !FABLE_COMPILER - let mapAB = plus mapA mapB - #endif - #if !FABLE_COMPILER - let _greeting1 = Async.RunSynchronously mapAB.[2] - let _greeting2 = Async.RunSynchronously (Seq.sum [mapA; zero; mapB]).[2] - #endif - - #if !FABLE_COMPILER - let dicA = new Dictionary> () - dicA.["keya"] <- (result "Hey" : Task<_>) - dicA.["keyb"] <- (result "Hello": Task<_>) - - let dicB = new Dictionary> () - dicB.["keyc"] <- (result " You" : Task<_>) - dicB.["keyb"] <- (result " World": Task<_>) - - let dicAB = plus dicA dicB - let _iDicAb = plus (dicA :> IDictionary<_,_>) (dicB :> IDictionary<_,_>) - let _iroDicAb = plus (dicA :> IReadOnlyDictionary<_,_>) (dicB :> IReadOnlyDictionary<_,_>) - - let _greeting3 = extract dicAB.["keyb"] - let _greeting4 = extract (Seq.sum [dicA; zero; dicB]).["keyb"] - - let _res2 = Seq.sum [async {return Endo ((+) 2)}; async {return Endo ((*) 10)}; async {return Endo id}; async {return Endo ((%) 3)}; async {return zero} ] |> Async.RunSynchronously |> Endo.run <| 3 - let _res330 = Seq.sum [async {return (fun (x:int) -> string x)}; async {return (fun (x:int) -> string (x*10))}; async {return zero } ] 3 - #endif - () + let monoid = testList "Monoid" [ testCase "seqSumDefaultCustom" (fun () -> #if !FABLE_COMPILER diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/MonoidCompile.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/MonoidCompile.fs new file mode 100644 index 000000000..c3cb17f2a --- /dev/null +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/MonoidCompile.fs @@ -0,0 +1,110 @@ +module General.MonoidCompile +open Testing +open General.Util +open FSharpPlus +open System.Collections.Generic + +open FSharpPlus.Data +#nowarn "686" +#if !FABLE_COMPILER +open System.Threading.Tasks +#endif + +#if !FABLE_COMPILER || FABLE_COMPILER_3 +type ZipList<'s> = ZipList of 's seq with + static member Return (x:'a) = ZipList (Seq.initInfinite (konst x)) + static member Map (ZipList x, f: 'a->'b) = ZipList (Seq.map f x) + static member (<*>) (ZipList (f: seq<'a->'b>), ZipList x) = ZipList (Seq.zip f x |> Seq.map (fun (f,x) -> f x)) : ZipList<'b> + static member inline get_Zero () = result zero : ZipList<'a> + static member inline (+) (x:ZipList<'a>, y:ZipList<'a>) = lift2 plus x y :ZipList<'a> + static member ToSeq (ZipList lst) = lst + +type ZipList'<'s> = ZipList' of 's seq with + static member Return (x: 'a) = ZipList' (Seq.initInfinite (konst x)) + static member Map (ZipList' x, f: 'a->'b) = ZipList' (Seq.map f x) + static member (<*>) (ZipList' (f: seq<'a->'b>), ZipList' x) = ZipList' (Seq.zip f x |> Seq.map (fun (f,x) -> f x)) : ZipList'<'b> + static member inline get_Zero () = result zero : ZipList'<'a> + static member inline (+) (x: ZipList'<'a>, y: ZipList'<'a>) = lift2 plus x y :ZipList'<'a> + static member inline Sum (x: seq>) = SideEffects.add "Using optimized Sum"; List.foldBack plus (Seq.toList x) zero : ZipList'<'a> + static member ToSeq (ZipList' lst) = lst +#endif + +type MyList<'t> = MyList of list<'t> with + static member get_Empty () = MyList [] + static member (<|>) (MyList x, MyList y) = MyList (x @ y) + +type MyNum = MyNum of int with + static member get_Empty () = MyNum 0 + static member FromInt32 x = MyNum x + + +let testCompile = + #if !FABLE_COMPILER + + let _res1n2 = MyList [1] ++ MyList [2] ++ zero + let _res0 : MyNum = zero + let _asQuotation = plus <@ ResizeArray (["1"]) @> <@ ResizeArray (["2;3"]) @> + let _quot123 = plus <@ ResizeArray ([1]) @> <@ ResizeArray ([2;3]) @> + let _quot1 = plus <@ ResizeArray ([1]) @> (zero) + let _quot23 = plus (zero) <@ ResizeArray ([2;3]) @> + let _quot13 = plus (zero) <@ ("1","3") @> + #endif + #if !FABLE_COMPILER || FABLE_COMPILER_3 + let lzy1 = plus (lazy [1]) (lazy [2;3]) + #endif + #if !FABLE_COMPILER + let _lzy = plus (zero) lzy1 + #endif + #if !FABLE_COMPILER || FABLE_COMPILER_3 + let asy1 = plus (async.Return [1]) (async.Return [2;3]) + #endif + #if !FABLE_COMPILER + let _asy = plus (zero) asy1 + let _bigNestedTuple1 = (1, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ (2, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ (3, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) + let _bigNestedTuple2 = (1, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ (zero, System.Tuple (8, "ff",3,4,5,6,7,8,9,10,11,12,(),14,15,16,17,18,19,20)) ++ zero + #endif + + #if !FABLE_COMPILER || FABLE_COMPILER_3 + let _nes : NonEmptySeq<_> = plus (NonEmptySeq.singleton 1) (NonEmptySeq.singleton 2) + #endif + + let mapA = Map.empty + |> Map.add 1 (async.Return "Hey") + |> Map.add 2 (async.Return "Hello") + + let mapB = Map.empty + |> Map.add 3 (async.Return " You") + |> Map.add 2 (async.Return " World") + + #if !FABLE_COMPILER + let mapAB = plus mapA mapB + #endif + #if !FABLE_COMPILER + let _greeting1 = Async.RunSynchronously mapAB.[2] + let _greeting2 = Async.RunSynchronously (Seq.sum [mapA; zero; mapB]).[2] + #endif + + #if !FABLE_COMPILER + let dicA = new Dictionary> () + dicA.["keya"] <- (result "Hey" : Task<_>) + dicA.["keyb"] <- (result "Hello": Task<_>) + + let dicB = new Dictionary> () + dicB.["keyc"] <- (result " You" : Task<_>) + dicB.["keyb"] <- (result " World": Task<_>) + + let dicAB = plus dicA dicB + let _iDicAb = plus (dicA :> IDictionary<_,_>) (dicB :> IDictionary<_,_>) + let _iroDicAb = plus (dicA :> IReadOnlyDictionary<_,_>) (dicB :> IReadOnlyDictionary<_,_>) + + let _greeting3 = extract dicAB.["keyb"] + let _greeting4 = extract (Seq.sum [dicA; zero; dicB]).["keyb"] + + let _res2 = Seq.sum [async {return Endo ((+) 2)}; async {return Endo ((*) 10)}; async {return Endo id}; async {return Endo ((%) 3)}; async {return zero} ] |> Async.RunSynchronously |> Endo.run <| 3 + let _res330 = Seq.sum [async {return (fun (x:int) -> string x)}; async {return (fun (x:int) -> string (x*10))}; async {return zero } ] 3 + #endif + () +let monoidCompile = testList "monoidCompile" [ + testCase "MonoidCompile" (fun () -> + ()) + ] \ No newline at end of file diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/Splits.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/Splits.fs new file mode 100644 index 000000000..a6744faf5 --- /dev/null +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/Splits.fs @@ -0,0 +1,74 @@ +module General.Splits +open Testing +open General.Util +open FSharpPlus +open System.Collections.Generic + +open FSharpPlus.Data +#nowarn "686" +#if !FABLE_COMPILER +open System.Threading.Tasks +#endif + +type Sum<'a> = Sum of 'a with + static member inline get_Zero () = Sum 0 + static member inline (+) (Sum (x:'n), Sum (y:'n)) = Sum (x + y) + + +let splits = testList "Splits" [ + + #if !FABLE_COMPILER || FABLE_COMPILER_3 + testCase "splitArraysAndStrings" (fun () -> + let a1 = "this.isABa.tABCest" |> split [|"AT" ; "ABC" |] + let a2 = "this.isABa.tABCest"B |> split [|"AT"B; "ABC"B|] + + let b1 = "this.is.a.t...est" |> split [|"." ; "..." |] + let b2 = "this.is.a.t...est"B |> split [|"."B; "..."B|] + + Assert.IsTrue ((toList a1 = ["this.isABa.t"; "est"])) + Assert.IsTrue ((toList a2 = [[|116uy; 104uy; 105uy; 115uy; 46uy; 105uy; 115uy; 65uy; 66uy; 97uy; 46uy; 116uy|]; [|101uy; 115uy; 116uy|]])) + Assert.IsTrue ((toList b1 = ["this"; "is"; "a"; "t"; ""; ""; "est"])) + Assert.IsTrue ((toList b2 = [[|116uy; 104uy; 105uy; 115uy|]; [|105uy; 115uy|]; [|97uy|]; [|116uy|]; [||]; [||]; [|101uy; 115uy; 116uy|]])) + + #if !FABLE_COMPILER + Assert.IsInstanceOf> (Some a1) + #endif + ) + + testCase "replaceArraysAndStrings" (fun () -> + let a1 = "this.isABa.tABCest" |> replace "AT" "ABC" + let a2 = "this.isABa.tABCest"B |> replace "AT"B "ABC"B + + let b1 = "this.is.a.t...est" |> replace "." "..." + let b2 = "this.is.a.t...est"B |> replace "."B "..."B + + Assert.IsTrue ((a1 = "this.isABa.tABCest")) + Assert.IsTrue ((a2 = [|116uy; 104uy; 105uy; 115uy; 46uy; 105uy; 115uy; 65uy; 66uy; 97uy; 46uy; 116uy; 65uy; 66uy; 67uy; 101uy; 115uy; 116uy|])) + Assert.IsTrue ((b1 = "this...is...a...t.........est")) + Assert.IsTrue ((b2 = [|116uy; 104uy; 105uy; 115uy; 46uy; 46uy; 46uy; 105uy; 115uy; 46uy; 46uy; 46uy; 97uy; 46uy; 46uy; 46uy; 116uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 46uy; 101uy; 115uy; 116uy|])) + ) + + testCase "intercalateArraysAndStrings" (fun () -> + let a1 = [|"this" ; "is" ; "a" ; "test" |] |> intercalate " " + let a2 = [|"this"B; "is"B; "a"B; "test"B|] |> intercalate " "B + + //let b = [WrappedListB [1;2]; WrappedListB [3;4]; WrappedListB [6;7]] |> intercalate (WrappedListB [0;1]) + + // /Control/Monoid.fs(..): (..) error FABLE: Cannot resolve trait call + - Inline call from ./Collection.fs(..) < ../../../tests/FSharpPlusFable.Tests/FSharpTests/General.fs(..) + #if !FABLE_COMPILER + let _c = [| Sum 1; Sum 2 |] |> intercalate (Sum 10) + let d = WrappedListB [Sum 1; Sum 2] |> intercalate (Sum 10) + let _e = intercalate 10 (seq [1; 2; 3]) + #endif + + Assert.IsTrue((a1 = "this is a test")) + Assert.IsTrue((a2 = [|116uy; 104uy; 105uy; 115uy; 32uy; 105uy; 115uy; 32uy; 97uy; 32uy; 116uy; 101uy; 115uy; 116uy|])) + //Assert.IsTrue((b = WrappedListB [1; 2; 0; 1; 3; 4; 0; 1; 6; 7])) + // Assert.IsTrue((c = Sum 13)) + #if !FABLE_COMPILER + Assert.IsTrue((d = Sum 13)) + #endif + ) + #endif + + ] \ No newline at end of file diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs index dcf80fac8..a8dbe1dc7 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs @@ -30,15 +30,6 @@ let toLists x = if x <> 4 then [x; x] else [] let toEithers x = if x <> 4 then Right x else Left ["This is a failure"] #endif -let expectedEffects = - [ - """f(x) <*> Right 0""" - """f(x) <*> Right 1""" - """f(x) <*> Right 2""" - """f(x) <*> Right 3""" - """f(x) <*> Left ["This is a failure"]""" - ] - let traversable = testList "Traversable" [ // Exception: TypeError: o[Symbol.iterator] is not a function @@ -142,6 +133,15 @@ let traversable = testList "Traversable" [ #if !FABLE_COMPILER testCase "traverseInfiniteApplicatives" (fun () -> + let expectedEffects = + [ + """f(x) <*> Right 0""" + """f(x) <*> Right 1""" + """f(x) <*> Right 2""" + """f(x) <*> Right 3""" + """f(x) <*> Left ["This is a failure"]""" + ] + SideEffects.reset () let a = sequence (Seq.initInfinite toOptions) @@ -193,6 +193,7 @@ let traversable = testList "Traversable" [ #if !FABLE_COMPILER || FABLE_COMPILER_3 testList "traverseFiniteApplicatives" [ // TODO -> implement short-circuit without breaking anything else + #if !FABLE_COMPILER testCase "a" (fun () -> SideEffects.reset () @@ -240,6 +241,14 @@ let traversable = testList "Traversable" [ ()) testCase "e" (fun () -> + let expectedEffects = + [ + """f(x) <*> Right 0""" + """f(x) <*> Right 1""" + """f(x) <*> Right 2""" + """f(x) <*> Right 3""" + """f(x) <*> Left ["This is a failure"]""" + ] SideEffects.reset () let e = sequence (Seq.initInfinite toEithers |> Seq.take 20 |> Seq.toList) SideEffects.are expectedEffects @@ -251,6 +260,14 @@ let traversable = testList "Traversable" [ ()) testCase "f" (fun () -> + let expectedEffects = + [ + """f(x) <*> Right 0""" + """f(x) <*> Right 1""" + """f(x) <*> Right 2""" + """f(x) <*> Right 3""" + """f(x) <*> Left ["This is a failure"]""" + ] SideEffects.reset () let f = sequence (Seq.initInfinite toEithers |> Seq.take 20 |> Seq.toArray) SideEffects.are expectedEffects