Skip to content

Instantly share code, notes, and snippets.

@zecl
Created March 31, 2013 13:03
Show Gist options
  • Save zecl/5280535 to your computer and use it in GitHub Desktop.
Save zecl/5280535 to your computer and use it in GitHub Desktop.
FsControl (https://github.com/gmpl/FsControl) を拡張してお遊び
#r @"bin\Debug\FsControl.Core.dll" // from https://github.com/gmpl/FsControl
module Monad =
open FsControl.Core.Abstractions
let do' = new Monad.DoNotationBuilder()
module MonadPlus =
open Monad
open FsControl.Core.Abstractions.MonadPlus
// DoPlus notation (MonadPlus)
type DoPlusNotationBuilder() =
member inline b.Return(a) = do'.Return a
member inline b.Bind(m,f) = do'.Bind (m, f)
member inline b.Let (p,rest) = do'.Let (p,rest)
member inline b.ReturnFrom(m) = do'.ReturnFrom(m)
// MonadPlus
member inline b.Zero() = Inline.instance Mzero ()
member inline b.Combine(x, y) = Inline.instance (Mplus, x) y
let doPlus = new DoPlusNotationBuilder ()
module FSharpComputationExpressions =
open System
open MonadPlus
type DefaultImpl =
static member inline DelayFromComputationExpression f = f
static member inline RunFromComputationExpression f = f
static member inline TryWithFromComputationExpression c h = try c() with e -> h e
static member inline TryFinallyFromComputationExpression c compensation = try c() finally compensation ()
static member inline UsingFromComputationExpression (res:#IDisposable) (body:#IDisposable -> _) = DefaultImpl.TryFinallyFromComputationExpression (body res) (fun () -> match res with null -> () | disp -> disp.Dispose())
type Combine = Combine with
static member instance (Combine, m:option<'a>,_:option<'a>) = fun (d:unit-> option<'a>) -> if Option.isSome m then m else d ():option<'a>
static member instance (Combine, m:list<'a>,_:list<'a>) = fun (d:unit-> list<'a>) -> m @ d() :list<'a>
let inline combine m d = Inline.instance (Combine, m) d
type TryWith = TryWith with
static member instance (TryWith, c:unit->option<'a>,_:option<'a>) = fun (h:exn -> option<'a>) -> DefaultImpl.TryWithFromComputationExpression c h
static member instance (TryWith, c:unit->list<'a>,_:list<'a>) = fun (h:exn -> list<'a>)-> DefaultImpl.TryWithFromComputationExpression c h
let inline tryWith c h = Inline.instance (TryWith,c) h
type TryFinally = TryFinally with
static member instance (TryFinally, c:unit->option<'a>,_:option<'a>) = fun f -> DefaultImpl.TryFinallyFromComputationExpression c f
static member instance (TryFinally, c:unit->list<'a>,_:list<'a>)= fun f-> DefaultImpl.TryFinallyFromComputationExpression c f
let inline tryFinally c (f:unit->unit) = Inline.instance (TryFinally, c) f
type Using = Using with
static member inline instance (Using, body:#IDisposable-> option<'a>, _:option<'a>) = fun (res:#IDisposable) -> tryFinally (fun () -> body res) (fun () -> match res with null -> () | disp -> disp.Dispose())
static member inline instance (Using, body:#IDisposable-> list<'a>, _:list<'a>) = fun (res:#IDisposable) -> tryFinally (fun () -> body res) (fun () -> match res with null -> () | disp -> disp.Dispose())
let inline using' (res:#IDisposable) body = Inline.instance (Using, body) res
// DoFSharp notation
type DoFSharpNotationBuilder() =
member inline b.Return(a) = doPlus.Return a
member inline b.Bind(m,f) = doPlus.Bind (m, f)
member inline b.Let (p,rest) = doPlus.Let (p,rest)
member inline b.ReturnFrom(m) = doPlus.ReturnFrom m
// Other Computation Expressions
member inline b.Zero() = doPlus.Zero ()
member inline b.Combine(x, y) = combine x y
member inline b.Delay(f) = f
member inline b.Run(f) = f()
member inline b.TryWith(d,h) = tryWith d h
member inline b.TryFinally(c,f) = tryFinally c f
member inline b.Using(res,body) = using' res body
// member inline b.While(guard,f) = while' guard f
// member inline b.For(sequence,body) = for' sequence body
// member inline b.Yield(a) = yield' a
// member inline b.YieldFrom(m) = yieldFrom' m
let dofs = new DoFSharpNotationBuilder()
module Sample =
open System
open MonadPlus
open FSharpComputationExpressions
let hoge =
doPlus {
let! a = Some 10
let! b = Some 100
if a < b then
return b - a
else
return a - b }
hoge |> printfn "%A"
// Some 90
let createDisposable f = { new IDisposable with member x.Dispose() = f() }
let fuga =
dofs {
let! x = Some "F#"
let! y = Some "is fun!"
use res = createDisposable (fun () -> printf "%s" "dispose;")
try
try
failwith "fail"
return "VB6 is fun!"
with
| ex -> printf "%s" "error;"
return String.Format("{0} {1}", x, y)
()
finally
printf "%s" "finally;" }
fuga |> printfn "%A"
// error;finally;dispose;Some "F# is fun!"
let piyo =
dofs {
let! a = ["A";"B";]
let! b = [1..5]
try
if b < 4 then
return a + string b
finally
printf "%s" <| String.Format("{0}{1};", a, b)
}
piyo |> printfn "%A"
// A1;A2;A3;A4;A5;B1;B2;B3;B4;B5;["A1"; "A2"; "A3"; "B1"; "B2"; "B3"]
Console.ReadKey () |> ignore
@gusty
Copy link

gusty commented Nov 16, 2013

I was working in FsControl and seems that I did some breaking changes, sorry.
Here is your gist updated.
I'm planning to implement a more fsharp-ish workflow like yours at some point.
BTW have a look at FSharpPlus it defines almost all let bindings for FsControl.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment