1+ namespace FSharp.Compiler.UnitTests
2+
3+ open NUnit.Framework
4+ open FSharp.TestHelpers
5+ open FSharp.Compiler .SourceCodeServices
6+
7+ [<TestFixture>]
8+ module ComputationExpressionTests =
9+
10+ [<Test>]
11+ let ``do - bang can be used with nested CE expressions`` () =
12+ let code = """
13+ module Code
14+ type ResultBuilder() =
15+ member __.Return value = Ok value
16+ member __.ReturnFrom (result: Result<_,_>) = result
17+ member x.Zero() = x.Return ()
18+ member __.Bind(r: Result<'t,_>, binder: 't -> Result<_,_>) = match r with | Ok r' -> binder r' | Error e -> e
19+ member __.Delay(gen: unit -> Result<_,_>) = gen
20+ member __.Run(gen: unit -> Result<_,_>) = gen()
21+ member _.BindReturn(x: Result<'t,_>, f) = Result.map f x
22+ member inline _.Source(result : Result<_,_>) : Result<_,_> = result
23+
24+ let result = ResultBuilder()
25+
26+ module Result =
27+ let zip x1 x2 =
28+ match x1,x2 with
29+ | Ok x1res, Ok x2res -> Ok (x1res, x2res)
30+ | Error e, _ -> Error e
31+ | _, Error e -> Error e
32+ let ofChoice c =
33+ match c with
34+ | Choice1Of2 x -> Ok x
35+ | Choice2Of2 x -> Error x
36+ let fold onOk onError r =
37+ match r with
38+ | Ok x -> onOk x
39+ | Error y -> onError y
40+
41+ module Async =
42+ let inline singleton value = value |> async.Return
43+ let inline bind f x = async.Bind(x, f)
44+ let inline map f x = x |> bind (f >> singleton)
45+ let zip a1 a2 = async {
46+ let! r1 = a1
47+ let! r2 = a2
48+ return r1,r2
49+ }
50+
51+ module AsyncResult =
52+ let zip x1 x2 =
53+ Async.zip x1 x2
54+ |> Async.map(fun (r1, r2) -> Result.zip r1 r2)
55+ let foldResult onSuccess onError ar =
56+ Async.map (Result.fold onSuccess onError) ar
57+
58+ type AsyncResultBuilder() =
59+
60+ member __.Return (value: 'T) : Async<Result<'T, 'TError>> =
61+ async.Return <| result.Return value
62+
63+ member inline __.ReturnFrom
64+ (asyncResult: Async<Result<'T, 'TError>>)
65+ : Async<Result<'T, 'TError>> =
66+ asyncResult
67+
68+ member __.Zero () : Async<Result<unit, 'TError>> =
69+ async.Return <| result.Zero ()
70+
71+ member inline __.Bind
72+ (asyncResult: Async<Result<'T, 'TError>>,
73+ binder: 'T -> Async<Result<'U, 'TError>>)
74+ : Async<Result<'U, 'TError>> =
75+ async {
76+ let! result = asyncResult
77+ match result with
78+ | Ok x -> return! binder x
79+ | Error x -> return Error x
80+ }
81+
82+ member __.Delay
83+ (generator: unit -> Async<Result<'T, 'TError>>)
84+ : Async<Result<'T, 'TError>> =
85+ async.Delay generator
86+
87+ member this.Combine
88+ (computation1: Async<Result<unit, 'TError>>,
89+ computation2: Async<Result<'U, 'TError>>)
90+ : Async<Result<'U, 'TError>> =
91+ this.Bind(computation1, fun () -> computation2)
92+
93+ member __.TryWith
94+ (computation: Async<Result<'T, 'TError>>,
95+ handler: System.Exception -> Async<Result<'T, 'TError>>)
96+ : Async<Result<'T, 'TError>> =
97+ async.TryWith(computation, handler)
98+
99+ member __.TryFinally
100+ (computation: Async<Result<'T, 'TError>>,
101+ compensation: unit -> unit)
102+ : Async<Result<'T, 'TError>> =
103+ async.TryFinally(computation, compensation)
104+
105+ member __.Using
106+ (resource: 'T when 'T :> System.IDisposable,
107+ binder: 'T -> Async<Result<'U, 'TError>>)
108+ : Async<Result<'U, 'TError>> =
109+ async.Using(resource, binder)
110+
111+ member this.While
112+ (guard: unit -> bool, computation: Async<Result<unit, 'TError>>)
113+ : Async<Result<unit, 'TError>> =
114+ if not <| guard () then this.Zero ()
115+ else this.Bind(computation, fun () -> this.While (guard, computation))
116+
117+ member this.For
118+ (sequence: #seq<'T>, binder: 'T -> Async<Result<unit, 'TError>>)
119+ : Async<Result<unit, 'TError>> =
120+ this.Using(sequence.GetEnumerator (), fun enum ->
121+ this.While(enum.MoveNext,
122+ this.Delay(fun () -> binder enum.Current)))
123+
124+ member inline __.BindReturn(x: Async<Result<'T,'U>>, f) = async.Bind(x, fun r -> Result.map f r |> async.Return)
125+ member inline __.MergeSources(t1: Async<Result<'T,'U>>, t2: Async<Result<'T1,'U>>) =
126+ AsyncResult.zip t1 t2
127+
128+ member inline _.Source(result : Async<Result<_,_>>) : Async<Result<_,_>> = result
129+
130+ module ARExts =
131+ type AsyncResultBuilder with
132+ /// <summary>
133+ /// Needed to allow `for..in` and `for..do` functionality
134+ /// </summary>
135+ member inline __.Source(s: #seq<_>) = s
136+
137+ /// <summary>
138+ /// Method lets us transform data types into our internal representation.
139+ /// </summary>
140+ member inline _.Source(result : Result<_,_>) : Async<Result<_,_>> = Async.singleton result
141+
142+ /// <summary>
143+ /// Method lets us transform data types into our internal representation.
144+ /// </summary>
145+ member inline _.Source(choice : Choice<_,_>) : Async<Result<_,_>> =
146+ choice
147+ |> Result.ofChoice
148+ |> Async.singleton
149+
150+ /// <summary>
151+ /// Method lets us transform data types into our internal representation.
152+ /// </summary>
153+ member inline __.Source(asyncComputation : Async<_>) : Async<Result<_,_>> = asyncComputation |> Async.map Ok
154+
155+ let asyncResult = AsyncResultBuilder()
156+
157+ asyncResult {
158+ let! something = asyncResult { return 5 }
159+ do! asyncResult {
160+ return ()
161+ }
162+ return something
163+ }
164+ |> AsyncResult.foldResult id (fun (_err: string) -> 10)
165+ |> Async.RunSynchronously
166+ |> printfn "%d
167+ """
168+ CompilerAssert.Pass code
0 commit comments