[WIP] Option Builder

Basis.ComputationExpression.Tests/Basis.ComputationExpression.Tests.fsproj

@@ -32,11 +32,37 @@
     <WarningLevel>3</WarningLevel>
     <DocumentationFile>bin\Release\Basis.ComputationExpression.Tests.XML</DocumentationFile>
   </PropertyGroup>
+  <PropertyGroup>
+    <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
+  </PropertyGroup>
+  <Choose>
+    <When Condition="'$(VisualStudioVersion)' == '11.0'">
+      <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
+        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
+      </PropertyGroup>
+    </When>
+    <Otherwise>
+      <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
+        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
+      </PropertyGroup>
+    </Otherwise>
+  </Choose>
+  <Import Project="$(FSharpTargetsPath)" />
+  <ItemGroup>
+    <Compile Include="FsCheck.NUnit.fs" />
+    <Compile Include="OptionTest.fs" />
+    <None Include="app.config" />
+    <None Include="packages.config" />
+  </ItemGroup>
   <ItemGroup>
     <Reference Include="Basis.Core">
       <HintPath>..\packages\Basis.Core.1.1.3.0\lib\net40\Basis.Core.dll</HintPath>
       <Private>True</Private>
     </Reference>
+    <Reference Include="FsCheck">
+      <HintPath>..\packages\FsCheck.0.9.4.0\lib\net40-Client\FsCheck.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
     <Reference Include="FsUnit.NUnit">
       <HintPath>..\packages\FsUnit.1.3.0.1\Lib\Net40\FsUnit.NUnit.dll</HintPath>
       <Private>True</Private>
@@ -54,34 +80,12 @@
     <Reference Include="System.Numerics" />
     <Reference Include="System.Xml" />
     <Reference Include="System.Xml.Linq" />
-  </ItemGroup>
-  <ItemGroup>
     <ProjectReference Include="..\Basis.ComputationExpression\Basis.ComputationExpression.fsproj">
       <Name>Basis.ComputationExpression</Name>
       <Project>{ff80c295-8935-4c3e-8e68-5a887df157e7}</Project>
       <Private>True</Private>
     </ProjectReference>
   </ItemGroup>
-  <ItemGroup>
-    <None Include="app.config" />
-    <None Include="packages.config" />
-  </ItemGroup>
-  <PropertyGroup>
-    <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
-  </PropertyGroup>
-  <Choose>
-    <When Condition="'$(VisualStudioVersion)' == '11.0'">
-      <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets')">
-        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
-      </PropertyGroup>
-    </When>
-    <Otherwise>
-      <PropertyGroup Condition="Exists('$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets')">
-        <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
-      </PropertyGroup>
-    </Otherwise>
-  </Choose>
-  <Import Project="$(FSharpTargetsPath)" />
   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
        Other similar extension points exist, see Microsoft.Common.targets.
   <Target Name="BeforeBuild">

Basis.ComputationExpression.Tests/FsCheck.NUnit.fs

@@ -0,0 +1,31 @@
+module FsCheck.NUnit
+
+open FsCheck
+open NUnit.Framework
+
+let runner =
+  { new IRunner with
+      member x.OnStartFixture t = ()
+      member x.OnArguments(ntets: int, args: obj list, every: int -> obj list -> string) = ()
+      member x.OnShrink(args, everyShrink) = ()
+      member x.OnFinished(name, result) =
+        match result with
+        | TestResult.True _ -> ()
+        | _ -> Assert.Fail(Runner.onFinishedToString name result) }
+
+let config = { Config.Default with Runner = runner }
+
+let check testable =
+  Check.One ("", config, testable)
+
+open System
+
+type NullableGen =
+  static member Nullable () =
+    Arb.fromGen (gen {
+      let! x = Arb.generate<_ option>
+      return
+        match x with Some x -> Nullable x | None -> Nullable<_>()
+    })
+
+do Arb.register<NullableGen>() |> ignore

Basis.ComputationExpression.Tests/OptionTest.fs

@@ -0,0 +1,65 @@
+module OptionTest
+
+open NUnit.Framework
+open FsUnit
+open FsCheck
+open FsCheck.NUnit
+
+[<TestFixture>]
+module MinimumComputationTest =
+  open Basis.ComputationExpression.Option.MinimumComputation
+
+  [<Test>]
+  let ``return x >>= f =  f x`` () =
+    let f x = if x = 0 then None else Some (1000 / x)
+    check (fun x -> option.Bind(option.Return(x), f) = f x)
+    check (fun x -> option { let! y = option.Return(x) in return! f y } = f x)
+
+  [<Test>]
+  let ``m >>= return  =  m`` () =
+    check (fun m -> option.Bind(m, option.Return) = m)
+    check (fun m -> option { let! x = m in return x } = m)
+
+  [<Test>]
+  let ``(m >>= f) >>= g  =  m >>= (fun x -> f x >>= g)`` () =
+    let f x = if x = 0 then None else Some (1000 / x)
+    let g x = if x < 10 then None else Some (x / 10)
+    check (fun m -> option.Bind(option.Bind(m, f), g) = option.Bind(m, fun x -> option.Bind(f x, g)))
+    check (fun m ->
+      option {
+        let! y =
+          option {
+            let! x = m
+            return! f x
+          }
+        return! g y
+      } = option {
+        let! x = m
+        let! y = f x
+        return! g y
+      }
+    )
+
+  module WithZeroTest =
+    open Basis.ComputationExpression.Option.MinimumComputation.WithZero
+
+    [<Test>]
+    let ``can use zero``() =
+      option { () } |> should equal None
+
+  module WithUsingTest =
+    open Basis.ComputationExpression.Option.MinimumComputation.WithUsing
+
+    type Disposable() =
+      interface System.IDisposable with
+        member this.Dispose() = ()
+
+    [<Test>]
+    let ``can use use``() =
+      option {
+        use x = new Disposable()
+        use! y = Some (new Disposable())
+        use! z = None
+        return 42
+      } |> should equal None
+

Basis.ComputationExpression.Tests/app.config

@@ -4,7 +4,7 @@
     <assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
       <dependentAssembly>
         <assemblyIdentity name="FSharp.Core" publicKeyToken="b03f5f7f11d50a3a" culture="neutral" />
-        <bindingRedirect oldVersion="0.0.0.0-4.3.0.0" newVersion="4.3.0.0" />
+        <bindingRedirect oldVersion="0.0.0.0-4.3.1.0" newVersion="4.3.0.0" />
       </dependentAssembly>
     </assemblyBinding>
   </runtime>

Basis.ComputationExpression.Tests/packages.config

@@ -1,6 +1,7 @@
 <?xml version="1.0" encoding="utf-8"?>
 <packages>
   <package id="Basis.Core" version="1.1.3.0" targetFramework="net40" />
+  <package id="FsCheck" version="0.9.4.0" targetFramework="net40" />
   <package id="FsUnit" version="1.3.0.1" targetFramework="net40" />
   <package id="NUnit" version="2.6.3" targetFramework="net40" />
 </packages>

Basis.ComputationExpression/Basis.ComputationExpression.fsproj

@@ -32,24 +32,6 @@
     <WarningLevel>3</WarningLevel>
     <DocumentationFile>bin\Release\Basis.ComputationExpression.XML</DocumentationFile>
   </PropertyGroup>
-  <ItemGroup>
-    <Reference Include="Basis.Core">
-      <HintPath>..\packages\Basis.Core.1.1.3.0\lib\net40\Basis.Core.dll</HintPath>
-      <Private>True</Private>
-    </Reference>
-    <Reference Include="mscorlib" />
-    <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
-      <Private>True</Private>
-    </Reference>
-    <Reference Include="System" />
-    <Reference Include="System.Core" />
-    <Reference Include="System.Numerics" />
-    <Reference Include="System.Xml" />
-    <Reference Include="System.Xml.Linq" />
-  </ItemGroup>
-  <ItemGroup>
-    <None Include="packages.config" />
-  </ItemGroup>
   <PropertyGroup>
     <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
   </PropertyGroup>
@@ -66,6 +48,26 @@
     </Otherwise>
   </Choose>
   <Import Project="$(FSharpTargetsPath)" />
+  <ItemGroup>
+    <Compile Include="Option.fsi" />
+    <Compile Include="Option.fs" />
+    <None Include="packages.config" />
+  </ItemGroup>
+  <ItemGroup>
+    <Reference Include="Basis.Core">
+      <HintPath>..\packages\Basis.Core.1.1.3.0\lib\net40\Basis.Core.dll</HintPath>
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="mscorlib" />
+    <Reference Include="FSharp.Core, Version=$(TargetFSharpCoreVersion), Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
+      <Private>True</Private>
+    </Reference>
+    <Reference Include="System" />
+    <Reference Include="System.Core" />
+    <Reference Include="System.Numerics" />
+    <Reference Include="System.Xml" />
+    <Reference Include="System.Xml.Linq" />
+  </ItemGroup>
   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
        Other similar extension points exist, see Microsoft.Common.targets.
   <Target Name="BeforeBuild">

Basis.ComputationExpression/Option.fs

@@ -0,0 +1,56 @@
+namespace Basis.ComputationExpression
+
+open System
+
+type FlowControl = Break | Continue
+
+module Option =
+  module MinimumComputation =
+    type OptionBuilder () =
+      member this.Bind(x, f) = Option.bind f x
+      member this.Return(x) = Some x
+      member this.ReturnFrom(x: 'T option) = x
+
+    let option = OptionBuilder ()
+
+    module WithZero =
+      type OptionBuilder with
+        member this.Zero() = None
+
+    module WithUsing =
+      type OptionBuilder with
+        member this.Using(x: #IDisposable, f) =
+          try f x
+          finally match box x with null -> () | notNull -> x.Dispose()
+
+  module FullComputation =
+    type OptionBuilder () =
+      member this.Zero() = None, Continue
+      member this.Return(x) = Some x, Break
+      member this.ReturnFrom(x: 'T option) = x, Break
+      member this.Bind(x: 'T option, f: 'T -> 'U option * FlowControl) = (Option.bind (f >> fst) x), Continue
+      member this.Using(x: #IDisposable, f) =
+        try f x
+        finally match box x with null -> () | notNull -> x.Dispose()
+      member this.Combine(m, cont) =
+        match m with
+        | x, Continue -> if Option.isSome x then x, Break else cont ()
+        | other -> m
+      member this.TryWith(f: unit -> 'T option * FlowControl, h) = try f () with e -> h e
+      member this.TryFinally(f: unit -> 'T option * FlowControl, g) = try f () finally g ()
+      member this.While(guard, f) =
+        let isExit = ref false
+        let res = ref None
+        while guard () && not !isExit do
+          match f () with
+          | x, Break -> isExit := true; res := x
+          | x, Continue -> if Option.isSome x then res := x
+        if !isExit then !res, Break else !res, Continue
+      member this.For(xs: #seq<'T>, f) =
+        this.Using(
+          xs.GetEnumerator(),
+          fun itor -> this.While(itor.MoveNext, fun () -> f itor.Current))
+      member this.Delay(f: unit -> 'T option * FlowControl) = f
+      member this.Run(f: unit -> 'T option * FlowControl) = f () |> fst
+
+    let option = OptionBuilder ()

Basis.ComputationExpression/Option.fsi

@@ -0,0 +1,43 @@
+namespace Basis.ComputationExpression
+
+open System
+
+type FlowControl
+
+module Option =
+  module MinimumComputation =
+    type OptionBuilder = class
+      new: unit -> OptionBuilder
+      member Bind: 'T option * ('T -> 'U option) -> 'U option
+      member Return: 'T -> 'T option
+      member ReturnFrom: 'T option -> 'T option
+    end
+
+    val option: OptionBuilder
+
+    module WithZero =
+      type OptionBuilder with
+        member Zero: unit -> 'T option
+
+    module WithUsing =
+      type OptionBuilder with
+        member Using<'T, 'U when 'T :> IDisposable> : 'T * ('T -> 'U) -> 'U
+
+  module FullComputation =
+    type OptionBuilder = class
+      new: unit -> OptionBuilder
+      member Zero: unit -> 'T option * FlowControl
+      member Return: 'T -> 'T option * FlowControl
+      member ReturnFrom: 'T option -> 'T option * FlowControl
+      member Bind: 'T option * ('T -> 'U option * FlowControl) -> 'U option * FlowControl
+      member Using<'T, 'U when 'T :> IDisposable> : 'T * ('T -> 'U) -> 'U
+      member Combine: ('T option * FlowControl) * (unit -> 'T option * FlowControl) -> 'T option * FlowControl
+      member TryWith: (unit -> 'T option * FlowControl) * (exn -> 'T option * FlowControl) -> 'T option * FlowControl
+      member TryFinally: (unit -> 'T option * FlowControl) * (unit -> unit) -> 'T option * FlowControl
+      member While: (unit -> bool) * (unit -> 'T option * FlowControl) -> 'T option * FlowControl
+      member For: #seq<'T> * ('T -> 'U option * FlowControl) -> 'U option * FlowControl
+      member Delay: (unit -> 'T option * FlowControl) -> (unit -> 'T option * FlowControl)
+      member Run: (unit -> 'T option * FlowControl) -> 'T option
+    end
+
+    val option: OptionBuilder