16 people like it.

Tiny IO Monad

Haskell-style IO in F#.

IO Monad

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
namespace Haskell.Prelude

type IO<'T> = private | Action of (unit -> 'T)

[<AutoOpen>]
module MonadIO =
    let private mreturn x = Action (fun () -> x)
    let private run  io               = match io  with Action f -> f ()
    let private bind io  rest : IO<_> = match io  with Action f -> rest (f ())
    let private comb io1 (io2:IO<_>)  = match io1 with Action f -> f (); io2
    
    type IOBuilder() =
        member b.Run(io)           = run io
        member b.Return(x)         = mreturn x
        member b.ReturnFrom(io)    = io : IO<_>
        member b.Delay(g)          = mreturn (run (g ()))
        member b.Bind(io, rest)    = bind io rest
        member b.Combine(io1, io2) = comb io1 io2
    
    let io = new IOBuilder()
    let (|Action|) io = run io

[<AutoOpen>]
module PreludeIO =
    let putChar  (c:char)   = Action (fun () -> stdout.Write(c))
    let putStr   (s:string) = Action (fun () -> stdout.Write(s))
    let putStrLn (s:string) = Action (fun () -> stdout.WriteLine(s))
    let print x             = Action (fun () -> printfn "%A" x)
    let getChar     = Action (fun () -> stdin.Read() |> char |> string)
    let getLine     = Action (fun () -> stdin.ReadLine())
    let getContents = Action (fun () -> stdin.ReadToEnd())

Usage

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
namespace HaskellStyleIO

open System
open Haskell.Prelude

module Program =
    let lines (s:string) = s.Split([|stdout.NewLine|], StringSplitOptions.None) |> Seq.ofArray
    let length xs = Seq.length xs
    
    [<EntryPoint>]
    let main _ =
        // get/put two lines
        let (Action ()) = io {
            let! cs1 = getLine
            let! cs2 = getLine
            return! putStrLn cs1
            return  putStrLn cs2
        }
        // cat
        let (Action ()) = io {
            let! cs = getContents
            return putStr cs
        }
        // wc -l
        let (Action ()) = io {
            let! cs = getContents
            return cs |> lines |> length |> print
        }
        0
namespace Haskell
namespace Haskell.Prelude
union case IO.Action: (unit -> 'T) -> IO<'T>
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
val private mreturn : x:'a -> IO<'a>

Full name: Haskell.Prelude.MonadIO.mreturn
val x : 'a
val private run : io:IO<'a> -> 'a

Full name: Haskell.Prelude.MonadIO.run
val io : IO<'a>
val f : (unit -> 'a)
val private bind : io:IO<'a> -> rest:('a -> IO<'b>) -> IO<'b>

Full name: Haskell.Prelude.MonadIO.bind
val rest : ('a -> IO<'b>)
type IO<'T> = private | Action of (unit -> 'T)

Full name: Haskell.Prelude.IO<_>
val private comb : io1:IO<unit> -> io2:IO<'a> -> IO<'a>

Full name: Haskell.Prelude.MonadIO.comb
val io1 : IO<unit>
val io2 : IO<'a>
val f : (unit -> unit)
Multiple items
type IOBuilder =
  new : unit -> IOBuilder
  member Bind : io:IO<'b> * rest:('b -> IO<'c>) -> IO<'c>
  member Combine : io1:IO<unit> * io2:IO<'a> -> IO<'a>
  member Delay : g:(unit -> IO<'d>) -> IO<'d>
  member Return : x:'f -> IO<'f>
  member ReturnFrom : io:IO<'e> -> IO<'e>
  member Run : io:IO<'g> -> 'g

Full name: Haskell.Prelude.MonadIO.IOBuilder

--------------------
new : unit -> IOBuilder
val b : IOBuilder
member IOBuilder.Run : io:IO<'g> -> 'g

Full name: Haskell.Prelude.MonadIO.IOBuilder.Run
val io : IO<'g>
member IOBuilder.Return : x:'f -> IO<'f>

Full name: Haskell.Prelude.MonadIO.IOBuilder.Return
val x : 'f
member IOBuilder.ReturnFrom : io:IO<'e> -> IO<'e>

Full name: Haskell.Prelude.MonadIO.IOBuilder.ReturnFrom
val io : IO<'e>
member IOBuilder.Delay : g:(unit -> IO<'d>) -> IO<'d>

Full name: Haskell.Prelude.MonadIO.IOBuilder.Delay
val g : (unit -> IO<'d>)
member IOBuilder.Bind : io:IO<'b> * rest:('b -> IO<'c>) -> IO<'c>

Full name: Haskell.Prelude.MonadIO.IOBuilder.Bind
val io : IO<'b>
val rest : ('b -> IO<'c>)
member IOBuilder.Combine : io1:IO<unit> * io2:IO<'a> -> IO<'a>

Full name: Haskell.Prelude.MonadIO.IOBuilder.Combine
val io : IOBuilder

Full name: Haskell.Prelude.MonadIO.io
module PreludeIO

from Haskell.Prelude
val putChar : c:char -> IO<unit>

Full name: Haskell.Prelude.PreludeIO.putChar
val c : char
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = System.Char

Full name: Microsoft.FSharp.Core.char
Multiple items
union case IO.Action: (unit -> 'T) -> IO<'T>

--------------------
active recognizer Action: IO<'a> -> 'a

Full name: Haskell.Prelude.MonadIO.( |Action| )
val stdout<'T> : System.IO.TextWriter

Full name: Microsoft.FSharp.Core.Operators.stdout
val putStr : s:string -> IO<unit>

Full name: Haskell.Prelude.PreludeIO.putStr
val s : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val putStrLn : s:string -> IO<unit>

Full name: Haskell.Prelude.PreludeIO.putStrLn
val print : x:'a -> IO<unit>

Full name: Haskell.Prelude.PreludeIO.print
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val getChar : IO<string>

Full name: Haskell.Prelude.PreludeIO.getChar
val stdin<'T> : System.IO.TextReader

Full name: Microsoft.FSharp.Core.Operators.stdin
val getLine : IO<string>

Full name: Haskell.Prelude.PreludeIO.getLine
val getContents : IO<string>

Full name: Haskell.Prelude.PreludeIO.getContents
namespace System
module Program

from HaskellStyleIO
val lines : s:string -> seq<string>

Full name: HaskellStyleIO.Program.lines
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
String.Split([<ParamArray>] separator: char []) : string []
String.Split(separator: string [], options: StringSplitOptions) : string []
String.Split(separator: char [], options: StringSplitOptions) : string []
String.Split(separator: char [], count: int) : string []
String.Split(separator: string [], count: int, options: StringSplitOptions) : string []
String.Split(separator: char [], count: int, options: StringSplitOptions) : string []
val stdout<'T> : IO.TextWriter

Full name: Microsoft.FSharp.Core.Operators.stdout
type StringSplitOptions =
  | None = 0
  | RemoveEmptyEntries = 1

Full name: System.StringSplitOptions
field StringSplitOptions.None = 0
module Seq

from Microsoft.FSharp.Collections
val ofArray : source:'T [] -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.ofArray
val length : xs:seq<'a> -> int

Full name: HaskellStyleIO.Program.length
val xs : seq<'a>
val length : source:seq<'T> -> int

Full name: Microsoft.FSharp.Collections.Seq.length
Multiple items
type EntryPointAttribute =
  inherit Attribute
  new : unit -> EntryPointAttribute

Full name: Microsoft.FSharp.Core.EntryPointAttribute

--------------------
new : unit -> EntryPointAttribute
val main : string [] -> int

Full name: HaskellStyleIO.Program.main
Multiple items
active recognizer Action: IO<'a> -> 'a

Full name: Haskell.Prelude.MonadIO.( |Action| )

--------------------
type Action =
  delegate of unit -> unit

Full name: System.Action

--------------------
type Action<'T> =
  delegate of 'T -> unit

Full name: System.Action<_>

--------------------
type Action<'T1,'T2> =
  delegate of 'T1 * 'T2 -> unit

Full name: System.Action<_,_>

--------------------
type Action<'T1,'T2,'T3> =
  delegate of 'T1 * 'T2 * 'T3 -> unit

Full name: System.Action<_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 -> unit

Full name: System.Action<_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 -> unit

Full name: System.Action<_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 -> unit

Full name: System.Action<_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 -> unit

Full name: System.Action<_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13,'T14> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 * 'T14 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13,'T14,'T15> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 * 'T14 * 'T15 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_,_,_>

--------------------
type Action<'T1,'T2,'T3,'T4,'T5,'T6,'T7,'T8,'T9,'T10,'T11,'T12,'T13,'T14,'T15,'T16> =
  delegate of 'T1 * 'T2 * 'T3 * 'T4 * 'T5 * 'T6 * 'T7 * 'T8 * 'T9 * 'T10 * 'T11 * 'T12 * 'T13 * 'T14 * 'T15 * 'T16 -> unit

Full name: System.Action<_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_>
val cs1 : string
val cs2 : string
val cs : string

More information

Link:http://fssnip.net/6i
Posted:13 years ago
Author:igeta
Tags: io , monad , computation builder