├── .gitignore ├── bin └── HtmlAgilityPack.dll ├── docs ├── async-sequences │ └── decor.png ├── async-sequences.fsi └── async-sequences.fsx ├── src ├── Agents │ ├── Agent.fs │ ├── ConcurrentSetAgent.fs │ ├── BatchProcessingAgent.fs │ ├── SlidingWindowAgent.fs │ ├── BlockingQueueAgent.fs │ └── AutoCancelAgent.fs ├── Async.fs ├── FSharp.AsyncExtensions.sln ├── FSharp.AsyncExtensions.fsproj ├── IO.fs ├── Observable.fs └── AsyncSeq.fs ├── samples ├── Caching.fsx ├── BlockingQueue.fsx ├── BatchProcessing.fsx ├── AutoCancel.fsx ├── MouseFollow.fsx ├── AsyncSeqObservable.fsx ├── StockStream.fsx ├── WebProxy.fsx ├── ChatServer.fsx └── Crawler.fsx ├── README.markdown └── License.markdown /.gitignore: -------------------------------------------------------------------------------- 1 | *.dll 2 | *.pdb 3 | FSharp.ASyncExtensions.xml 4 | bin/release -------------------------------------------------------------------------------- /bin/HtmlAgilityPack.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tpetricek/FSharp.AsyncExtensions/HEAD/bin/HtmlAgilityPack.dll -------------------------------------------------------------------------------- /docs/async-sequences/decor.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tpetricek/FSharp.AsyncExtensions/HEAD/docs/async-sequences/decor.png -------------------------------------------------------------------------------- /src/Agents/Agent.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (Agent.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | /// Type alias for F# mailbox processor type 8 | type Agent<'T> = MailboxProcessor<'T> 9 | -------------------------------------------------------------------------------- /src/Agents/ConcurrentSetAgent.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (ConcurrentSetAgent.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | open System 8 | 9 | // ---------------------------------------------------------------------------- 10 | 11 | /// Agent that implements a simple concurrent set. The agent exposes a 12 | /// member that adds value to the set and returns whether the value 13 | /// was already present. 14 | type ConcurrentSetAgent<'T>() = 15 | let agent = Agent.Start(fun agent -> async { 16 | let hashSet = new System.Collections.Generic.HashSet<_>(HashIdentity.Structural) 17 | while true do 18 | let! value, (repl:AsyncReplyChannel<_>) = agent.Receive() 19 | repl.Reply(hashSet.Add(value)) }) 20 | 21 | /// Adds the specified element to the set and returns 22 | /// 'false' when it was already present in the set 23 | member x.AsyncAdd(v) = agent.PostAndAsyncReply(fun repl -> v, repl) 24 | -------------------------------------------------------------------------------- /samples/Caching.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AutoCancel.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to use 'Async.Cache' and 'AsyncSeq.cache' 7 | 8 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 9 | open FSharp.Control 10 | 11 | // The Async.Cache combinator makes it possible to create asynchronous 12 | // workflow that caches the result and performs computation only once 13 | // when called multiple times. 14 | let op = 15 | async { // Will be printed just once 16 | printfn "Evaluating..." 17 | return 42 } 18 | |> Async.Cache 19 | 20 | Async.RunSynchronously(op) 21 | Async.RunSynchronously(op) 22 | 23 | 24 | // The AsyncSeq.cache combinator has similar effect - the asynchronous 25 | // sequence can be used multiple times, but it will evaluate just once 26 | let asq = 27 | asyncSeq { for i in 0 .. 10 do 28 | printfn "Generating %d..." i 29 | yield i } 30 | |> AsyncSeq.cache 31 | 32 | AsyncSeq.iter (printfn "Consuming %d") asq 33 | |> Async.RunSynchronously -------------------------------------------------------------------------------- /samples/BlockingQueue.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (BlockingQueue.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to use 'BlockingAgent' 7 | // The agent implements producer/consumer concurrent pattern. 8 | 9 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 10 | open FSharp.Control 11 | 12 | let buffer = new BlockingQueueAgent(3) 13 | 14 | // The sample uses two workflows that add/take elements 15 | // from the buffer with the following timeouts. When the producer 16 | // timout is larger, consumer will be blocked. Otherwise, producer 17 | // will be blocked. 18 | let producerTimeout = 500 19 | let consumerTimeout = 1000 20 | 21 | async { 22 | for i in 0 .. 10 do 23 | // Sleep for some time and then add value 24 | do! Async.Sleep(producerTimeout) 25 | do! buffer.AsyncAdd(i) 26 | printfn "Added %d" i } 27 | |> Async.Start 28 | 29 | async { 30 | while true do 31 | // Sleep for some time and then get value 32 | do! Async.Sleep(consumerTimeout) 33 | let! v = buffer.AsyncGet() 34 | printfn "Got %d" v } 35 | |> Async.Start -------------------------------------------------------------------------------- /samples/BatchProcessing.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (BatchProcessing.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to use 'BatchProcessingAgent' 7 | // The agent groups received messages in groups with a maximal 8 | // size and emits them with a maximal timeout. 9 | 10 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 11 | open FSharp.Control 12 | 13 | open System.Drawing 14 | open System.Windows.Forms 15 | 16 | // Create simple winforms user interface with label 17 | let frm = new Form() 18 | let lbl = new Label(Font = new Font("Calibri", 20.0f), Dock = DockStyle.Fill) 19 | lbl.TextAlign <- ContentAlignment.MiddleCenter 20 | frm.Controls.Add(lbl) 21 | frm.Show() 22 | 23 | // Handle key press events but update the GUI after 5 keys 24 | // have been pressed or after 5 seconds (whichever happens first) 25 | let ag = new BatchProcessingAgent<_>(5, 5000) 26 | frm.KeyPress.Add(fun e -> ag.Enqueue(e.KeyChar)) 27 | ag.BatchProduced 28 | |> Event.map (fun chars -> new System.String(chars)) 29 | |> Event.scan (+) "" 30 | |> Event.add (fun str -> lbl.Text <- str) 31 | 32 | -------------------------------------------------------------------------------- /samples/AutoCancel.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AutoCancel.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to use 'AutoCancelAgent' 7 | // The agent automatically stops its body when disposed. 8 | 9 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 10 | open FSharp.Control 11 | 12 | let op = async { 13 | // Create a local agent that is disposed when the 14 | // workflow completes (using the 'use' construct) 15 | use agent = AutoCancelAgent.Start(fun agent -> async { 16 | try 17 | while true do 18 | // Wait for a message - note that we use timeout 19 | // to allow cancellation (when the operation completes) 20 | let! msg = agent.Receive(1000) 21 | match msg with 22 | | (n, reply:AsyncReplyChannel) -> 23 | // Print number and reply to the sender 24 | printfn "%d" n 25 | reply.Reply(()) 26 | | _ -> () 27 | finally 28 | // Called when the agent is disposed 29 | printfn "agent completed" }) 30 | 31 | // Do some processing using the agent... 32 | for i in 0 .. 10 do 33 | do! Async.Sleep(100) 34 | do! agent.PostAndAsyncReply(fun r -> i, r) 35 | 36 | do! Async.Sleep(100) 37 | printfn "workflow completed" } 38 | 39 | Async.Start(op) 40 | -------------------------------------------------------------------------------- /samples/MouseFollow.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (StockSlidingWindow.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to implement a simple mouse following 7 | // algorithm using asynchronous sequences and Observable.window 8 | 9 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 10 | 11 | open FSharp.Control 12 | open System.Drawing 13 | open System.Windows.Forms 14 | 15 | let form = new Form(Visible=true, TopMost=true) 16 | 17 | // Asynchronous sequence that returns cursor position at the 50 FPS rate 18 | let updates = 19 | asyncSeq { 20 | while true do 21 | yield form.PointToClient(Cursor.Position) 22 | do! Async.Sleep(20) } 23 | |> AsyncSeq.toObservable 24 | 25 | // Turn the updates into floating point numbers and calculate average 26 | // over sliding window containing the last 20 values 27 | updates 28 | |> Observable.map (fun me -> float32 me.X, float32 me.Y) 29 | |> Observable.windowed 20 30 | |> Observable.map (fun win -> 31 | let x = Array.averageBy fst win 32 | let y = Array.averageBy snd win 33 | x, y) 34 | // Draw an ellispe at the calculated location 35 | |> Observable.add (fun (x, y) -> 36 | use gr = form.CreateGraphics() 37 | gr.Clear(Color.White) 38 | gr.FillEllipse(Brushes.DarkOliveGreen, x - 10.0f, y - 10.0f, 20.0f, 20.0f) ) 39 | -------------------------------------------------------------------------------- /src/Async.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AsyncSeq.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | open System 7 | 8 | // ---------------------------------------------------------------------------- 9 | 10 | [] 11 | module AsyncExtensions = 12 | 13 | type Microsoft.FSharp.Control.Async with 14 | 15 | /// Creates an asynchronous workflow that runs the asynchronous workflow 16 | /// given as an argument at most once. When the returned workflow is 17 | /// started for the second time, it reuses the result of the 18 | /// previous execution. 19 | static member Cache (input:Async<'T>) = 20 | let agent = Agent>.Start(fun agent -> async { 21 | let! repl = agent.Receive() 22 | let! res = input 23 | repl.Reply(res) 24 | while true do 25 | let! repl = agent.Receive() 26 | repl.Reply(res) }) 27 | async { return! agent.PostAndAsyncReply(id) } 28 | 29 | /// Starts the specified operation using a new CancellationToken and returns 30 | /// IDisposable object that cancels the computation. This method can be used 31 | /// when implementing the Subscribe method of IObservable interface. 32 | static member StartDisposable(op:Async) = 33 | let ct = new System.Threading.CancellationTokenSource() 34 | Async.Start(op, ct.Token) 35 | { new IDisposable with 36 | member x.Dispose() = ct.Cancel() } 37 | -------------------------------------------------------------------------------- /src/Agents/BatchProcessingAgent.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (BatchProcessingAgent.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | open System 8 | 9 | // ---------------------------------------------------------------------------- 10 | 11 | /// Agent that can be used to implement batch processing. It creates groups 12 | /// of messages (added using the Enqueue method) and emits them using the 13 | /// BatchProduced event. A group is produced when it reaches the maximal 14 | /// size or after the timeout elapses. 15 | type BatchProcessingAgent<'T>(bulkSize, timeout) = 16 | 17 | let bulkEvent = new Event<'T[]>() 18 | let agent : Agent<'T> = Agent.Start(fun agent -> 19 | let rec loop remainingTime messages = async { 20 | let start = DateTime.Now 21 | let! msg = agent.TryReceive(timeout = max 0 remainingTime) 22 | let elapsed = int (DateTime.Now - start).TotalMilliseconds 23 | match msg with 24 | | Some(msg) when 25 | List.length messages = bulkSize - 1 -> 26 | bulkEvent.Trigger(msg :: messages |> List.rev |> Array.ofList) 27 | return! loop timeout [] 28 | | Some(msg) -> 29 | return! loop (remainingTime - elapsed) (msg::messages) 30 | | None when List.length messages <> 0 -> 31 | bulkEvent.Trigger(messages |> List.rev |> Array.ofList) 32 | return! loop timeout [] 33 | | None -> 34 | return! loop timeout [] } 35 | loop timeout [] ) 36 | 37 | /// The event is triggered when a group of messages is collected. The 38 | /// group is not empty, but may not be of the specified maximal size 39 | /// (when the timeout elapses before enough messages is collected) 40 | [] 41 | member x.BatchProduced = bulkEvent.Publish 42 | 43 | /// Sends new message to the agent 44 | member x.Enqueue v = agent.Post(v) 45 | -------------------------------------------------------------------------------- /samples/AsyncSeqObservable.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AsyncSeqObservable.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to convert IObservable<'T> to AsyncSeq<'T> 7 | 8 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 9 | open FSharp.Control 10 | open System.Windows.Forms 11 | open System.Threading 12 | 13 | // Create simple winforms user interface with a button and multiline text box 14 | let frm = new Form(Visible=true, TopMost=true, Width=440) 15 | let btn = new Button(Left=10, Top=10, Width=150, Text="Async Operation") 16 | let out = new TextBox(Left=10, Top=40, Width=400, Height=200, Multiline=true) 17 | frm.Controls.Add(btn) 18 | frm.Controls.Add(out) 19 | 20 | // Prints message to the displayed text box 21 | let wprint fmt = 22 | Printf.kprintf (fun s -> out.Text <- out.Text + s) fmt 23 | 24 | 25 | // The sample demonstrates two ways of converting IObservable<_> values to 26 | // asynchronous sequences. When using 'AsyncSeq.ofObservable', values that are 27 | // emitted when the asynchronous sequence is blocked are discarded. When you 28 | // click on the 'Async Operation' button, the following workflow starts 29 | // processing and drops all clicks until the body of the for loop completes 30 | let discarding = 31 | async { 32 | for click in btn.Click |> AsyncSeq.ofObservable do 33 | wprint "Sleeping (and discarding clicks)...\r\n" 34 | do! Async.Sleep(1000) 35 | wprint "Done (listening again)\r\n" } 36 | 37 | let ctsd = new CancellationTokenSource() 38 | Async.Start(discarding, ctsd.Token) 39 | ctsd.Cancel() 40 | 41 | 42 | // When using 'AsyncSeq.ofObservableBuffered', the values emitted by the 43 | // observable while the asynchronous sequence is blocked are stored in a 44 | // buffer (and will be returned as next elements). 45 | let buffering = 46 | async { 47 | for click in btn.Click |> AsyncSeq.ofObservableBuffered do 48 | wprint "Sleeping (and buffering clicks)...\r\n" 49 | do! Async.Sleep(1000) 50 | wprint "Done (ready for next value)\r\n" } 51 | 52 | let ctsb = new CancellationTokenSource() 53 | Async.Start(buffering, ctsb.Token) 54 | ctsb.Cancel() -------------------------------------------------------------------------------- /src/Agents/SlidingWindowAgent.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (SlidingWindowAgent.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | open System 8 | 9 | // ---------------------------------------------------------------------------- 10 | 11 | /// Agent that implements the "sliding window" functionality. It collects 12 | /// messages added using the Enqueue method and emits them in overlapping 13 | /// groups of the specified size. For example, given [1,2,3,4,5...] and a 14 | /// size 3, the produced groups will be [1,2,3], [2,3,4], [3,4,5], ... 15 | type SlidingWindowAgent<'T>(windowSize, ?cancelToken) = 16 | 17 | // Event used to report groups 18 | let windowEvent = new Event<_>() 19 | 20 | // Start an agent that remembers partial windows of length 21 | // smaller than the count (new agent for every observer) 22 | let agent = Agent<'T>.Start((fun agent -> 23 | // The parameter 'lists' contains partial lists and their lengths 24 | let rec loop lists = async { 25 | // Receive the next value 26 | let! value = agent.Receive() 27 | 28 | // Add new empty list and then the new element to all lists. 29 | // Then split the lists into 'full' that should be sent 30 | // to the observer and 'partial' which need more elements. 31 | let full, partial = 32 | ((0, []) :: lists) 33 | |> List.map (fun (length, l) -> length + 1, value::l) 34 | |> List.partition (fun (length, l) -> length = windowSize) 35 | 36 | // Send all full lists to the observer (as arrays) 37 | for (_, l) in full do 38 | windowEvent.Trigger(l |> Array.ofSeq |> Array.rev) 39 | // Continue looping with incomplete lists 40 | return! loop partial } 41 | 42 | // Start with an empty list of partial lists 43 | loop []), ?cancellationToken = cancelToken) 44 | 45 | /// The event is triggered when a group of messages is collected. 46 | /// The size of the group is exactly 'count' and the values are 47 | /// returned in a fresh array. 48 | [] 49 | member x.WindowProduced = windowEvent.Publish 50 | 51 | /// Sends new message to the agent 52 | member x.Enqueue v = agent.Post(v) -------------------------------------------------------------------------------- /src/FSharp.AsyncExtensions.sln: -------------------------------------------------------------------------------- 1 | 2 | Microsoft Visual Studio Solution File, Format Version 11.00 3 | # Visual Studio 2010 4 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.AsyncExtensions", "FSharp.AsyncExtensions.fsproj", "{EDE1812B-5A62-410A-9553-02499CF29317}" 5 | EndProject 6 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Misc", "Misc", "{8406B0C7-14A3-42F1-AC7A-EE26C0A9F15E}" 7 | ProjectSection(SolutionItems) = preProject 8 | ..\License.markdown = ..\License.markdown 9 | ..\README.markdown = ..\README.markdown 10 | EndProjectSection 11 | EndProject 12 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Samples", "Samples", "{DD79E523-7072-4A67-89A0-257ECEF766D1}" 13 | ProjectSection(SolutionItems) = preProject 14 | ..\samples\AsyncSeqObservable.fsx = ..\samples\AsyncSeqObservable.fsx 15 | ..\samples\AutoCancel.fsx = ..\samples\AutoCancel.fsx 16 | ..\samples\BatchProcessing.fsx = ..\samples\BatchProcessing.fsx 17 | ..\samples\BlockingQueue.fsx = ..\samples\BlockingQueue.fsx 18 | ..\samples\Caching.fsx = ..\samples\Caching.fsx 19 | ..\samples\Crawler.fsx = ..\samples\Crawler.fsx 20 | ..\samples\MouseFollow.fsx = ..\samples\MouseFollow.fsx 21 | ..\samples\StockStream.fsx = ..\samples\StockStream.fsx 22 | ..\samples\WebProxy.fsx = ..\samples\WebProxy.fsx 23 | EndProjectSection 24 | EndProject 25 | Global 26 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 27 | Debug|Any CPU = Debug|Any CPU 28 | Debug|Mixed Platforms = Debug|Mixed Platforms 29 | Debug|x86 = Debug|x86 30 | Release|Any CPU = Release|Any CPU 31 | Release|Mixed Platforms = Release|Mixed Platforms 32 | Release|x86 = Release|x86 33 | EndGlobalSection 34 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 35 | {EDE1812B-5A62-410A-9553-02499CF29317}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 36 | {EDE1812B-5A62-410A-9553-02499CF29317}.Debug|Any CPU.Build.0 = Debug|Any CPU 37 | {EDE1812B-5A62-410A-9553-02499CF29317}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU 38 | {EDE1812B-5A62-410A-9553-02499CF29317}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU 39 | {EDE1812B-5A62-410A-9553-02499CF29317}.Debug|x86.ActiveCfg = Debug|Any CPU 40 | {EDE1812B-5A62-410A-9553-02499CF29317}.Release|Any CPU.ActiveCfg = Release|Any CPU 41 | {EDE1812B-5A62-410A-9553-02499CF29317}.Release|Any CPU.Build.0 = Release|Any CPU 42 | {EDE1812B-5A62-410A-9553-02499CF29317}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU 43 | {EDE1812B-5A62-410A-9553-02499CF29317}.Release|Mixed Platforms.Build.0 = Release|Any CPU 44 | {EDE1812B-5A62-410A-9553-02499CF29317}.Release|x86.ActiveCfg = Release|Any CPU 45 | EndGlobalSection 46 | GlobalSection(SolutionProperties) = preSolution 47 | HideSolutionNode = FALSE 48 | EndGlobalSection 49 | EndGlobal 50 | -------------------------------------------------------------------------------- /src/Agents/BlockingQueueAgent.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (BlockingQueueAgent.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | open System 8 | open System.Collections.Generic 9 | 10 | // ---------------------------------------------------------------------------- 11 | 12 | type internal BlockingAgentMessage<'T> = 13 | | Add of 'T * AsyncReplyChannel 14 | | Get of AsyncReplyChannel<'T> 15 | 16 | /// Agent that implements an asynchronous queue with blocking put 17 | /// and blocking get operation (this implements the producer-consumer 18 | /// concurrent programming pattern). The constructor takes the maximal 19 | /// size of the buffer. 20 | type BlockingQueueAgent<'T>(maxLength) = 21 | [] 22 | let mutable count = 0 23 | let agent = Agent.Start(fun agent -> 24 | 25 | let queue = new Queue<_>() 26 | 27 | let rec emptyQueue() = 28 | agent.Scan(fun msg -> 29 | match msg with 30 | | Add(value, reply) -> Some(enqueueAndContinue(value, reply)) 31 | | _ -> None ) 32 | and fullQueue() = 33 | agent.Scan(fun msg -> 34 | match msg with 35 | | Get(reply) -> Some(dequeueAndContinue(reply)) 36 | | _ -> None ) 37 | and runningQueue() = async { 38 | let! msg = agent.Receive() 39 | match msg with 40 | | Add(value, reply) -> return! enqueueAndContinue(value, reply) 41 | | Get(reply) -> return! dequeueAndContinue(reply) } 42 | 43 | and enqueueAndContinue (value, reply) = async { 44 | reply.Reply() 45 | queue.Enqueue(value) 46 | count <- queue.Count 47 | return! chooseState() } 48 | and dequeueAndContinue (reply) = async { 49 | reply.Reply(queue.Dequeue()) 50 | count <- queue.Count 51 | return! chooseState() } 52 | and chooseState() = 53 | if queue.Count = 0 then emptyQueue() 54 | elif queue.Count < maxLength then runningQueue() 55 | else fullQueue() 56 | 57 | // Start with an empty queue 58 | emptyQueue() ) 59 | 60 | /// Asynchronously adds item to the queue. The operation ends when 61 | /// there is a place for the item. If the queue is full, the operation 62 | /// will block until some items are removed. 63 | member x.AsyncAdd(v:'T, ?timeout) = 64 | agent.PostAndAsyncReply((fun ch -> Add(v, ch)), ?timeout=timeout) 65 | 66 | /// Asynchronously gets item from the queue. If there are no items 67 | /// in the queue, the operation will block unitl items are added. 68 | member x.AsyncGet(?timeout) = 69 | agent.PostAndAsyncReply(Get, ?timeout=timeout) 70 | 71 | /// Synchronously gets item from the queue. If there are no items 72 | /// in the queue, the operation will block unitl items are added. 73 | /// This method blocks until value is available! 74 | member x.Get(?timeout) = 75 | agent.PostAndReply(Get, ?timeout=timeout) 76 | 77 | /// Gets the number of elements currently waiting in the queue. 78 | member x.Count = count -------------------------------------------------------------------------------- /src/Agents/AutoCancelAgent.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AutoCancelAgent.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | open System 8 | open System.Threading 9 | 10 | // ---------------------------------------------------------------------------- 11 | // See also: http://fssnip.net/64 12 | 13 | /// Wrapper for the standard F# agent (MailboxProcessor) that 14 | /// supports stopping of the agent's body using the IDisposable 15 | /// interface (the type automatically creates a cancellation token) 16 | type AutoCancelAgent<'T> private (mbox:Agent<'T>, cts:CancellationTokenSource) = 17 | 18 | /// Start a new disposable agent using the specified body function 19 | /// (the method creates a new cancellation token for the agent) 20 | static member Start(f) = 21 | let cts = new CancellationTokenSource() 22 | new AutoCancelAgent<'T>(Agent<'T>.Start(f, cancellationToken = cts.Token), cts) 23 | 24 | /// Returns the number of unprocessed messages in the message queue of the agent. 25 | member x.CurrentQueueLength = mbox.CurrentQueueLength 26 | /// Occurs when the execution of the agent results in an exception. 27 | [] 28 | member x.Error = mbox.Error 29 | /// Waits for a message. This will consume the first message in arrival order. 30 | member x.Receive(?timeout) = mbox.Receive(?timeout = timeout) 31 | /// Scans for a message by looking through messages in arrival order until scanner 32 | /// returns a Some value. Other messages remain in the queue. 33 | member x.Scan(scanner, ?timeout) = mbox.Scan(scanner, ?timeout = timeout) 34 | /// Like PostAndReply, but returns None if no reply within the timeout period. 35 | member x.TryPostAndReply(buildMessage, ?timeout) = 36 | mbox.TryPostAndReply(buildMessage, ?timeout = timeout) 37 | /// Waits for a message. This will consume the first message in arrival order. 38 | member x.TryReceive(?timeout) = 39 | mbox.TryReceive(?timeout = timeout) 40 | /// Scans for a message by looking through messages in arrival order until scanner 41 | /// returns a Some value. Other messages remain in the queue. 42 | member x.TryScan(scanner, ?timeout) = 43 | mbox.TryScan(scanner, ?timeout = timeout) 44 | /// Posts a message to the message queue of the MailboxProcessor, asynchronously. 45 | member x.Post(m) = mbox.Post(m) 46 | /// Posts a message to an agent and await a reply on the channel, synchronously. 47 | member x.PostAndReply(buildMessage, ?timeout) = 48 | mbox.PostAndReply(buildMessage, ?timeout = timeout) 49 | /// Like PostAndAsyncReply, but returns None if no reply within the timeout period. 50 | member x.PostAndTryAsyncReply(buildMessage, ?timeout) = 51 | mbox.PostAndTryAsyncReply(buildMessage, ?timeout = timeout) 52 | /// Posts a message to an agent and await a reply on the channel, asynchronously. 53 | member x.PostAndAsyncReply(buildMessage, ?timeout) = 54 | mbox.PostAndAsyncReply(buildMessage, ?timeout=timeout) 55 | 56 | interface IDisposable with 57 | member x.Dispose() = 58 | (mbox :> IDisposable).Dispose() 59 | cts.Cancel() 60 | -------------------------------------------------------------------------------- /samples/StockStream.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (StockStream.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | 7 | // This example shows how to download stock prices from Yahooo and 8 | // return the result as an asynchronous sequence. The code that returns 9 | // the sequence downloads data from Yahoo in buffers and only downloads 10 | // the next buffer if it is required by the client (if it continues 11 | // iterating over the sequence). 12 | 13 | // Also available at: http://fssnip.net/7X 14 | 15 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 16 | 17 | open System 18 | open System.Net 19 | open System.Text 20 | open FSharp.IO 21 | open FSharp.Control 22 | open Microsoft.FSharp.Control.WebExtensions 23 | 24 | // ---------------------------------------------------------------------------- 25 | // Asynchronously downloading file from the web line-by-line 26 | 27 | /// Asynchronously download lines of a specified file 28 | /// (content is decuded using ASCII encoding) 29 | let downloadLines (url:string) = asyncSeq { 30 | // Create HTTP request and get response asynchronously 31 | let req = HttpWebRequest.Create(url) 32 | let! resp = req.AsyncGetResponse() 33 | let stream = resp.GetResponseStream() 34 | 35 | let str = ref "" 36 | // Download content in 1kB buffers 37 | for buffer in stream.AsyncReadSeq(1024) do 38 | // Decode buffer using ASCII and add to remaining text 39 | str := str.Value + String(Encoding.ASCII.GetChars(buffer)) + " " 40 | 41 | // Yield all lines except for the (incomplete) last one 42 | let parts = str.Value.Split([|'\n'; '\r'|], StringSplitOptions.RemoveEmptyEntries) 43 | for i in 0 .. parts.Length - 2 do 44 | yield parts.[i] 45 | 46 | // Save the unprocessed rest of text for the next iteration 47 | let rest = parts.[parts.Length - 1] 48 | str := rest.Substring(0, rest.Length - 1) 49 | 50 | // Yield the last line if it is not empty 51 | if str.Value <> "" then yield str.Value } 52 | 53 | // ---------------------------------------------------------------------------- 54 | // Getting stock prices from Yahoo 55 | 56 | // Yahoo URL with historical stock prices 57 | let ystock = "http://ichart.finance.yahoo.com/table.csv?s=" 58 | 59 | // Download data for MSFT and skip the header line 60 | downloadLines (ystock + "MSFT") 61 | |> AsyncSeq.skip 1 62 | |> AsyncSeq.map (fun line -> 63 | // Split line into Open, High, Low, Close values 64 | let infos = line.Split(',') 65 | float infos.[1], float infos.[2], float infos.[3], float infos.[4]) 66 | // Take first 30 values and start printing asynchronously 67 | |> AsyncSeq.take 30 68 | |> AsyncSeq.iter (printfn "%A") 69 | |> Async.Start 70 | 71 | // ---------------------------------------------------------------------------- 72 | // Wrap inside a reusable function 73 | 74 | /// Reusable function that downloads parsed stock prices 75 | let downloadStockPrices stock = 76 | downloadLines (ystock + stock) 77 | |> AsyncSeq.skip 1 78 | |> AsyncSeq.map (fun line -> 79 | // Split line into Open, High, Low, Close values 80 | let infos = line.Split(',') 81 | DateTime.Parse(infos.[0]), 82 | (float infos.[1], float infos.[2], float infos.[3], float infos.[4])) 83 | -------------------------------------------------------------------------------- /src/FSharp.AsyncExtensions.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Debug 5 | AnyCPU 6 | 8.0.30703 7 | 2.0 8 | {ede1812b-5a62-410a-9553-02499cf29317} 9 | Library 10 | FSharp.AsyncExtensions 11 | FSharp.AsyncExtensions 12 | v4.0 13 | FSharp.AsyncExtensions 14 | 15 | 16 | true 17 | full 18 | false 19 | false 20 | bin\Debug\ 21 | DEBUG;TRACE 22 | 3 23 | bin\Debug\FSharp.AsyncExtensions.XML 24 | --sig:sig.fsi 25 | 26 | 27 | pdbonly 28 | true 29 | true 30 | bin\Release\ 31 | TRACE 32 | 3 33 | bin\Release\FSharp.AsyncExtensions.XML 34 | 35 | 36 | 37 | 38 | copy $(ProjectDir)$(OutDir)\FSharp.AsyncExtensions.* $(ProjectDir)..\bin 39 | 40 | 41 | copy $(ProjectDir)$(OutDir)\FSharp.AsyncExtensions.* $(ProjectDir)..\bin\release 42 | nuget pack $(ProjectDir)..\bin\release\FSharp.AsyncExtensions.dll.nuspec 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 71 | -------------------------------------------------------------------------------- /src/IO.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (IO.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | namespace FSharp.IO 7 | open FSharp.Control 8 | // ---------------------------------------------------------------------------- 9 | // Extensions that simplify working with Stream using async sequences 10 | 11 | [] 12 | module IOExtensions = 13 | type System.IO.Stream with 14 | /// Asynchronously reads the stream in chunks of a specified size 15 | /// and returns the result as an asynchronous sequence. 16 | member x.AsyncReadSeq(?bufferSize) = 17 | let bufferSize = defaultArg bufferSize 1024 18 | let buffer = Array.zeroCreate bufferSize 19 | let rec loop () = asyncSeq { 20 | let! count = x.AsyncRead(buffer, 0, bufferSize) 21 | if count > 0 then 22 | yield Array.sub buffer 0 count 23 | yield! loop() } 24 | loop () 25 | 26 | /// Asynchronously writes all data specified by the 27 | /// given asynchronous sequence to the stream. 28 | member x.AsyncWriteSeq(input : AsyncSeq) = async { 29 | for data in input do 30 | do! x.AsyncWrite(data) } 31 | 32 | // ---------------------------------------------------------------------------- 33 | // Extensions that simplify working with HttpListener and related types 34 | 35 | namespace FSharp.Net 36 | open System.IO 37 | open System.Net 38 | open System.Text 39 | open System.Threading 40 | 41 | open FSharp.IO 42 | open FSharp.Control 43 | 44 | [] 45 | module HttpExtensions = 46 | 47 | type System.Net.HttpListener with 48 | /// Asynchronously waits for an incoming request and returns it. 49 | member x.AsyncGetContext() = 50 | Async.FromBeginEnd(x.BeginGetContext, x.EndGetContext) 51 | 52 | /// Starts HttpListener on the specified URL. The 'handler' function is 53 | /// called (in a new thread pool thread) each time an HTTP request is received. 54 | static member Start(url, handler, ?cancellationToken) = 55 | let server = async { 56 | use listener = new HttpListener() 57 | listener.Prefixes.Add(url) 58 | listener.Start() 59 | while true do 60 | let! context = listener.AsyncGetContext() 61 | Async.Start 62 | ( handler (context.Request, context.Response), 63 | ?cancellationToken = cancellationToken) } 64 | Async.Start(server, ?cancellationToken = cancellationToken) 65 | 66 | type System.Net.HttpListenerRequest with 67 | /// Asynchronously reads the 'InputStream' of the request and converts it to a string 68 | member request.AsyncInputString = async { 69 | use tmp = new MemoryStream() 70 | for data in request.InputStream.AsyncReadSeq(16 * 1024) do 71 | tmp.Write(data, 0, data.Length) 72 | tmp.Seek(0L, SeekOrigin.Begin) |> ignore 73 | use sr = new StreamReader(tmp) 74 | return sr.ReadToEnd() } 75 | 76 | 77 | type System.Net.HttpListenerResponse with 78 | /// Sends the specified string as a reply in UTF 8 encoding 79 | member response.AsyncReply(s:string) = async { 80 | let buffer = Encoding.UTF8.GetBytes(s) 81 | response.ContentLength64 <- int64 buffer.Length 82 | let output = response.OutputStream 83 | do! output.AsyncWrite(buffer,0,buffer.Length) 84 | output.Close() } 85 | 86 | /// Sends the specified data as a reply with the specified content type 87 | member response.AsyncReply(typ, buffer:byte[]) = async { 88 | response.ContentLength64 <- int64 buffer.Length 89 | let output = response.OutputStream 90 | response.ContentType <- typ 91 | do! output.AsyncWrite(buffer,0,buffer.Length) 92 | output.Close() } -------------------------------------------------------------------------------- /docs/async-sequences.fsi: -------------------------------------------------------------------------------- 1 | namespace FSharp.Control 2 | type AsyncSeq<'T> = Async> 3 | and AsyncSeqInner<'T> = 4 | | Nil 5 | | Cons of 'T * AsyncSeq<'T> 6 | 7 | module AsyncSeq = begin 8 | [] 9 | val empty<'T> : AsyncSeq<'T> 10 | val singleton : 'T -> AsyncSeq<'T> 11 | val append : AsyncSeq<'T> -> AsyncSeq<'T> -> AsyncSeq<'T> 12 | 13 | [] 14 | // [snippet:builder] 15 | type AsyncSeqBuilder = 16 | // Waits for the result of a single asynchronous 17 | // operation and then continues generating the sequence 18 | member Bind : Async<'T> * ('T -> AsyncSeq<'U>) -> AsyncSeq<'U> 19 | 20 | // For every element of the input (asynchronous) sequence, 21 | // yield all elements generated by the body of the for loop 22 | member For : AsyncSeq<'T> * ('T -> AsyncSeq<'TResult>) -> AsyncSeq<'TResult> 23 | member For : seq<'T> * ('T -> AsyncSeq<'TResult>) -> AsyncSeq<'TResult> 24 | 25 | // Yield single/zero elements and concatenation of sequences 26 | member Yield : 'T -> AsyncSeq<'T> 27 | member Zero : unit -> AsyncSeq<'T> 28 | member Combine : AsyncSeq<'T> * AsyncSeq<'T> -> AsyncSeq<'T> 29 | 30 | type Microsoft.FSharp.Control.AsyncBuilder with 31 | // For every element of the input asynchronous sequence, 32 | // perform the specified asynchronous workflow 33 | member For : AsyncSeq<'T> * ('T -> Async) -> Async 34 | // [/snippet] 35 | 36 | val asyncSeq : AsyncSeqBuilder 37 | val internal tryNext : AsyncSeq<'a> -> Async,exn>> 38 | val internal tryWith : AsyncSeq<'T> -> (exn -> AsyncSeq<'T>) -> AsyncSeq<'T> 39 | val internal tryFinally : AsyncSeq<'T> -> (unit -> unit) -> AsyncSeq<'T> 40 | val collect : 41 | ('T -> AsyncSeq<'TResult>) -> AsyncSeq<'T> -> AsyncSeq<'TResult> 42 | val mapAsync : ('T -> Async<'TResult>) -> AsyncSeq<'T> -> AsyncSeq<'TResult> 43 | val chooseAsync : ('T -> Async<'R option>) -> AsyncSeq<'T> -> AsyncSeq<'R> 44 | val filterAsync : ('T -> Async) -> AsyncSeq<'T> -> AsyncSeq<'T> 45 | val lastOrDefault : 'T -> AsyncSeq<'T> -> Async<'T> 46 | val firstOrDefault : 'T -> AsyncSeq<'T> -> Async<'T> 47 | val iterAsync : ('T -> Async) -> AsyncSeq<'T> -> Async 48 | val pairwise : AsyncSeq<'T> -> AsyncSeq<'T * 'T> 49 | 50 | // [snippet:fold/scan/take] 51 | // Aggregate all elements of async sequence using async function 52 | // and return the result (as an asynchronous workflow) 53 | val foldAsync : ('S -> 'T -> Async<'S>) -> 'S -> AsyncSeq<'T> -> Async<'S> 54 | 55 | // Aggregate elements and yield immediate results as an async sequence 56 | // (The input is accessed lazily as the result sequence is evaluated) 57 | val scanAsync : ('S -> 'T -> Async<'S>) -> 'S -> AsyncSeq<'T> -> AsyncSeq<'S> 58 | 59 | // Same as previous functions, but the aggregating function is synchronous 60 | val fold : ('S -> 'T -> 'S) -> 'S -> AsyncSeq<'T> -> Async<'S> 61 | val scan : ('S -> 'T -> 'S) -> 'S -> AsyncSeq<'T> -> AsyncSeq<'S> 62 | 63 | // Synchronous and asynchronous version of a function that returns 64 | // elements of the input sequence (lazily) while a predicate holds 65 | val takeWhileAsync : ('T -> Async) -> AsyncSeq<'T> -> AsyncSeq<'T> 66 | val takeWhile : ('T -> bool) -> AsyncSeq<'T> -> AsyncSeq<'T> 67 | // [/snippet] 68 | 69 | val map : ('T -> 'a) -> AsyncSeq<'T> -> AsyncSeq<'a> 70 | val iter : ('T -> unit) -> AsyncSeq<'T> -> Async 71 | val choose : ('T -> 'a option) -> AsyncSeq<'T> -> AsyncSeq<'a> 72 | val filter : ('T -> bool) -> AsyncSeq<'T> -> AsyncSeq<'T> 73 | val ofSeq : seq<'T> -> AsyncSeq<'T> 74 | type internal BufferMessage<'T> = 75 | | Get of AsyncReplyChannel<'T> 76 | | Put of 'T 77 | val ofObservableBuffered : System.IObservable<'a> -> AsyncSeq<'a> 78 | val ofObservable : System.IObservable<'a> -> AsyncSeq<'a> 79 | val toBlockingSeq : AsyncSeq<'T> -> seq<'T> 80 | val cache : AsyncSeq<'T> -> AsyncSeq<'T> 81 | val zip : AsyncSeq<'T1> -> AsyncSeq<'T2> -> AsyncSeq<'T1 * 'T2> 82 | val takeWhileAsync : ('T -> Async) -> AsyncSeq<'T> -> AsyncSeq<'T> 83 | val skipWhileAsync : ('T -> Async) -> AsyncSeq<'T> -> AsyncSeq<'T> 84 | val takeWhile : ('T -> bool) -> AsyncSeq<'T> -> AsyncSeq<'T> 85 | val skipWhile : ('T -> bool) -> AsyncSeq<'T> -> AsyncSeq<'T> 86 | val take : int -> AsyncSeq<'T> -> AsyncSeq<'T> 87 | val skip : int -> AsyncSeq<'T> -> AsyncSeq<'T> 88 | end 89 | module Seq = begin 90 | val ofAsyncSeq : AsyncSeq<'T> -> seq<'T> 91 | end 92 | module AsyncSeqExtensions = begin 93 | val asyncSeq : AsyncSeq.AsyncSeqBuilder 94 | type AsyncBuilder with 95 | member For : seq:AsyncSeq<'T> * action:('T -> Async) -> Async 96 | end 97 | 98 | module IOExtensions = begin 99 | // [snippet:extensions] 100 | type System.IO.Stream with 101 | // Read the entire stream as an asynchronous 102 | // sequence in chunks of the specified size 103 | member AsyncReadSeq : ?bufferSize:int -> AsyncSeq 104 | 105 | type System.IO.Stream with 106 | // Asynchronously write all data from an 107 | // asynchronous sequence to the current stream. 108 | member AsyncWriteSeq : AsyncSeq -> Async 109 | // [/snippet] 110 | end 111 | 112 | -------------------------------------------------------------------------------- /docs/async-sequences.fsx: -------------------------------------------------------------------------------- 1 | namespace FSharp 2 | #r @"C:\Tomas\Projects\FSharp\FSharp.AsyncExtensions\bin\FSharp.AsyncExtensions.dll" 3 | #r @"C:\Tomas\Projects\FSharp\FSharp.AsyncExtensions\bin\HtmlAgilityPack.dll" 4 | 5 | open FSharp.Control 6 | open System.Net 7 | open System 8 | 9 | module Control = 10 | // [snippet:Definition] 11 | /// Asynchronous computation that produces either end of a sequence 12 | /// (Nil) or the next value together with the rest of the sequence. 13 | type AsyncSeq<'T> = Async> 14 | and AsyncSeqInner<'T> = 15 | | Nil 16 | | Cons of 'T * AsyncSeq<'T> 17 | // [/snippet] 18 | 19 | type LazySeq<'T> = Lazy> 20 | and LazySeqInner<'T> = 21 | | Nil 22 | | Cons of 'T * LazySeq<'T> 23 | 24 | let rec nums n : LazySeq = 25 | lazy LazySeqInner.Cons(n, nums (n + 1)) 26 | 27 | let rec map f (ls : LazySeq<_>) = 28 | lazy match ls.Value with 29 | | Nil -> Nil 30 | | Cons(h, t) -> LazySeqInner.Cons(f h, map f t) 31 | 32 | module Samples = 33 | 34 | // [snippet:computation expressions #1] 35 | // When accessed, generates numbers 1 and 2. The number 36 | // is returned 1 second after value is requested. 37 | let oneTwo = asyncSeq { 38 | do! Async.Sleep(1000) 39 | yield 1 40 | do! Async.Sleep(1000) 41 | yield 2 } 42 | // [/snippet] 43 | 44 | // [snippet:computation expressions #2] 45 | let urls = 46 | [ "http://bing.com"; "http://yahoo.com"; 47 | "http://google.com"; "http://msn.com" ] 48 | 49 | // Asynchronous sequence that returns URLs and lengths 50 | // of the downloaded HTML. Web pages from a given list 51 | // are downloaded synchronously in sequence. 52 | let pages = asyncSeq { 53 | use wc = new WebClient() 54 | for url in urls do 55 | try 56 | let! html = wc.AsyncDownloadString(Uri(url)) 57 | yield url, html.Length 58 | with _ -> 59 | yield url, -1 } 60 | // [/snippet] 61 | 62 | // [snippet:using from async] 63 | // Asynchronous workflow that prints results 64 | async { 65 | for url, length in pages do 66 | printfn "%s (%d)" url length } 67 | |> Async.Start 68 | // [/snippet] 69 | 70 | // [snippet:combinators] 71 | // Print URL of pages that are smaller than 50k 72 | let printPages = 73 | pages 74 | |> AsyncSeq.filter (fun (_, len) -> len < 50000) 75 | |> AsyncSeq.map fst 76 | |> AsyncSeq.iter (printfn "%s") 77 | 78 | printPages |> Async.Start 79 | // [/snippet] 80 | 81 | // [snippet:combinators internals] 82 | /// Return elements for which the predicate returns true 83 | let filter f (input : AsyncSeq<'T>) = asyncSeq { 84 | for v in input do 85 | if f v then yield v } 86 | 87 | /// Return elements for which the asynchronous predicate returns true 88 | let filterAsync f (input : AsyncSeq<'T>) = asyncSeq { 89 | for v in input do 90 | let! b = f v 91 | if b then yield v } 92 | // [/snippet] 93 | 94 | module Crawler = 95 | 96 | open System.Text.RegularExpressions 97 | open HtmlAgilityPack 98 | 99 | /// Asynchronously download the document and parse the HTML 100 | let downloadDocument url = async { 101 | try let wc = new WebClient() 102 | let! html = wc.AsyncDownloadString(Uri(url)) 103 | let doc = new HtmlDocument() 104 | doc.LoadHtml(html) 105 | return Some doc 106 | with _ -> return None } 107 | 108 | /// Extract all links from the document that start with "http://" 109 | let extractLinks (doc:HtmlDocument) = 110 | try 111 | [ for a in doc.DocumentNode.SelectNodes("//a") do 112 | if a.Attributes.Contains("href") then 113 | let href = a.Attributes.["href"].Value 114 | if href.StartsWith("http://") then 115 | let endl = href.IndexOf('?') 116 | yield if endl > 0 then href.Substring(0, endl) else href ] 117 | with _ -> [] 118 | 119 | /// Extract the of the web page 120 | let getTitle (doc:HtmlDocument) = 121 | let title = doc.DocumentNode.SelectSingleNode("//title") 122 | if title <> null then title.InnerText.Trim() else "Untitled" 123 | 124 | // ---------------------------------------------------------------------------- 125 | 126 | // [snippet:crawler #1] 127 | /// Crawl the internet starting from the specified page. 128 | /// From each page follow the first not-yet-visited page. 129 | let rec randomCrawl url = 130 | let visited = new System.Collections.Generic.HashSet<_>() 131 | 132 | // Visits page and then recursively visits all referenced pages 133 | let rec loop url = asyncSeq { 134 | if visited.Add(url) then 135 | let! doc = downloadDocument url 136 | match doc with 137 | | Some doc -> 138 | // Yield url and title as the next element 139 | yield url, getTitle doc 140 | // For every link, yield all referenced pages too 141 | for link in extractLinks doc do 142 | yield! loop link 143 | | _ -> () } 144 | loop url 145 | // [/snippet] 146 | 147 | // [snippet:crawler #2] 148 | // Use AsyncSeq combinators to print the titles of the first 10 149 | // web sites that are from other domains than bing.com 150 | randomCrawl "http://news.bing.com" 151 | |> AsyncSeq.filter (fun (url, title) -> url.Contains("bing.com") |> not) 152 | |> AsyncSeq.map snd 153 | |> AsyncSeq.take 10 154 | |> AsyncSeq.iter (printfn "%s") 155 | |> Async.Start 156 | // [/snippet] -------------------------------------------------------------------------------- /samples/WebProxy.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AutoCancel.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to implement simple HTTP proxy 7 | 8 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 9 | open FSharp.Control 10 | open FSharp.IO 11 | open FSharp.Net 12 | 13 | open System 14 | open System.Net 15 | open System.Threading 16 | 17 | let root = "http://msdn.microsoft.com" 18 | let proxy = "http://localhost:8082/" 19 | 20 | // ---------------------------------------------------------------------------- 21 | // Simple web proxy implemented using 'HttpListener'. This version downloads 22 | // the entire web page as a string and then writes it to the response stream. 23 | 24 | let cts1 = new CancellationTokenSource() 25 | HttpListener.Start(proxy, (fun (req, resp) -> async { 26 | // Download the web page 27 | let url = root + req.Url.PathAndQuery 28 | let wc = new WebClient() 29 | let! html = wc.AsyncDownloadString(Uri(url)) 30 | 31 | // Replace URLs and send to the response stream 32 | let html = html.Replace(root, proxy) 33 | do! resp.AsyncReply(html) }), cancellationToken = cts1.Token) 34 | 35 | // Now go to: http://localhost:8082/en-us/fsharp 36 | cts1.Cancel() 37 | 38 | // ---------------------------------------------------------------------------- 39 | // Better version of a proxy - this time, we read data from the input stream 40 | // in chunks and write them to the response stream as they arive. 41 | 42 | let cts2 = new CancellationTokenSource() 43 | HttpListener.Start(proxy, (fun (req, resp) -> async { 44 | // Initialize the download 45 | let url = root + req.Url.PathAndQuery 46 | let targetReq = HttpWebRequest.Create(url) 47 | use! targetResp = targetReq.AsyncGetResponse() 48 | use stream = targetResp.GetResponseStream() 49 | 50 | // Copy data until we read the entire input 51 | let count = ref 1 52 | let buffer = Array.zeroCreate 4096 53 | while !count > 0 do 54 | let! read = stream.AsyncRead(buffer, 0, buffer.Length) 55 | do! resp.OutputStream.AsyncWrite(buffer, 0, read) 56 | count := read 57 | resp.Close() }), cancellationToken = cts2.Token) 58 | 59 | cts2.Cancel() 60 | 61 | // ---------------------------------------------------------------------------- 62 | // Proxy that copies data in chunks can be easily implemented using 63 | // asynchronous sequences. We read all data as asynchronous sequence and 64 | // write them to the output (Even simpler version could use 'AsyncWriteSeq' 65 | // to write all input buffers to the output stream). 66 | 67 | let cts3 = new CancellationTokenSource() 68 | HttpListener.Start(proxy, (fun (req, resp) -> async { 69 | // Initialize the download 70 | let url = root + req.Url.PathAndQuery 71 | let targetReq = HttpWebRequest.Create(url) 72 | use! targetResp = targetReq.AsyncGetResponse() 73 | use stream = targetResp.GetResponseStream() 74 | 75 | // Iterate over chunks read as an asynchronous sequence 76 | // and write them to the output stream 77 | for buffer in stream.AsyncReadSeq(4096) do 78 | do! resp.OutputStream.AsyncWrite(buffer, 0, buffer.Length) 79 | resp.Close() }), cancellationToken = cts3.Token) 80 | 81 | cts3.Cancel() 82 | 83 | // ---------------------------------------------------------------------------- 84 | // A more sophisticated version of proxy that caches web 85 | // pages using a simple agent. 86 | 87 | type CacheMessage = 88 | | TryGet of string * AsyncReplyChannel<option<byte[]>> 89 | | Add of string * byte[] 90 | 91 | // Creates an agent that handles 'CacheMessage' and implements the cache 92 | let cache = Agent.Start(fun agent -> async { 93 | let pages = new System.Collections.Generic.Dictionary<_, _>() 94 | while true do 95 | let! msg = agent.Receive() 96 | match msg with 97 | | TryGet(url, repl) -> 98 | // Try to get a value from the dictionary 99 | match pages.TryGetValue(url) with 100 | | true, data -> repl.Reply(Some(data)) 101 | | _ -> repl.Reply(None) 102 | | Add(url, data) -> 103 | // Add byte array to the cache 104 | pages.[url] <- data }) 105 | 106 | 107 | let cts4 = new CancellationTokenSource() 108 | HttpListener.Start(proxy, (fun (req, resp) -> async { 109 | // Generate URL and check data from the cache 110 | let url = root + req.Url.PathAndQuery 111 | let! cached = cache.PostAndAsyncReply(fun repl -> TryGet(url, repl)) 112 | match cached with 113 | | Some data -> 114 | // Reply using data from the cache 115 | do! resp.OutputStream.AsyncWrite(data) 116 | resp.Close() 117 | | None -> 118 | // Initialize the download 119 | let targetReq = HttpWebRequest.Create(url) 120 | use! targetResp = targetReq.AsyncGetResponse() 121 | use stream = targetResp.GetResponseStream() 122 | 123 | // Create a cached asynchronous sequence 124 | // (that reads the stream only once) 125 | let cachedData = stream.AsyncReadSeq(4096) |> AsyncSeq.cache 126 | 127 | // Start workflow that reads all data in memory (for caching) 128 | let! allBytes = 129 | cachedData 130 | |> AsyncSeq.fold (fun st data -> data::st) [] 131 | |> Async.StartChild 132 | // Write all data from the async sequence to the output 133 | for buffer in cachedData do 134 | do! resp.OutputStream.AsyncWrite(buffer, 0, buffer.Length) 135 | resp.Close() 136 | 137 | // Get all data accumulated in background and save 138 | // them to the cache (for later use) 139 | let! allData = allBytes 140 | let data = allData |> List.rev |> Array.concat 141 | cache.Post(Add(url, data)) }), cts4.Token) 142 | 143 | cts4.Cancel() 144 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | 2 | > **NOTE:** This project is no longer maintained. Please use/contribute to the following two projects instead: 3 | > 4 | > * [FSharp.Core.AsyncSeq](https://github.com/fsprojects/FSharp.Control.AsyncSeq) contains asynchronous sequences 5 | > * [FSharpx.Async](https://github.com/fsprojects/FSharpx.Async) contains other helpers from this repo (agents, `AwaitObservable`, etc.) 6 | > 7 | > I'm leaving this repo here in its original form, in case there is something else here that has not been moved 8 | > elsewhere, but I will not be accepting pull requests or maintaining it in any way. 9 | 10 | F# Async Extensions [ARCHIVED] 11 | ======================= 12 | 13 | This library implements various extensions for asynchronous programming 14 | using F# asynchronous workflows and F# agents (the `MailboxProcessor` type 15 | in the standard F# library). It defines _asynchronous sequences_ that represent 16 | asynchronous operations returning multiple values (such as reading data from 17 | a stream in chunks), several reusable F# agents and numerous extensions. 18 | 19 | * Samples that demonstrate how to use most of the extensions can 20 | be found in the [samples directory][7] 21 | 22 | Asynchronous sequences 23 | ---------------------- 24 | 25 | Asynchronous sequences can be used to work with asynchronous computations that return 26 | multiple results. A value of type `AsyncSeq<'T>` can be started (just like an asynchronous 27 | workflow) and it eventually returns. The result is either a special value representing 28 | the end of the sequence or a value of type `'T` (head) together with the rest of the 29 | asynchronous sequence (tail) of type `AsyncSeq<'T>`. 30 | 31 | Unlike `IObservable<'T>`, asynchronous sequences are not _push-based_. The code that 32 | generates the next value of the asynchronous sequence starts only after previous elements 33 | have been processed. This makes it possible to easily write computations that return 34 | results as long as some component is using them. 35 | 36 | However, `IObservable<'T>` values can 37 | be converted to asynchronous sequences. The `AsyncSeq.ofObservable` combinator creates an 38 | asynchronous sequence that discards values produced by the observable while the 39 | asynchronous sequence was blocked. The `AsyncSeq.ofObservableBuffered` combinator stores 40 | all produced values in an unbounded buffer and returns the values from the buffer as soon 41 | as the user of asynchronous sequence requestst the next element. 42 | 43 | The library defines an F# computation expression for workfing with asynchronous sequences. 44 | For example, sequence that emits numbers in 1 second intervals can be defined as follows: 45 | 46 | let rec numbers n = asyncSeq { 47 | yield n 48 | do! Async.Sleep(1000) 49 | yield! numbers (n + 1) } 50 | 51 | Asynchronous workflows and asynchronous sequences can use the `for` construct to iterate 52 | over all elements of an asynchronous sequence. For example: 53 | 54 | let rec evenNumbers = asyncSeq { 55 | for n in numbers 0 do 56 | if n%2=0 then yield n } 57 | 58 | The library also provides numerous combinators (similar to functions from the `Seq` module). 59 | The result of operations that aggregate values of an asynchronous sequence is an asynchronous 60 | workflow that returns a single value: 61 | 62 | let rec sumTenEvenSquares = 63 | numbers 0 64 | |> AsyncSeq.filter (fun n -> n%2 = 0) 65 | |> AsyncSeq.map (fun n -> n*n) 66 | |> AsyncSeq.fold (+) 0 67 | 68 | let n = 69 | sumTenEvenSquares 70 | |> Async.RunSynchronously 71 | 72 | For some examples that use (earlier versions) of asynchronous sequences, see also the following 73 | two F# snippets: [first][5] and [second][6]. 74 | 75 | Reusable agents 76 | --------------- 77 | 78 | The library implements several reusable agents for building concurrent applications: 79 | 80 | * **Agent** is a simple type aliast for `MailboxProcessor` that is more convenient to use 81 | 82 | * **AutoCancelAgent** wraps the standard F# agent and adds support for stopping of the 83 | agent's body using the `IDisposable` interface (the type automatically creates a 84 | cancellation token, uses it to start the underlying agent and cancels it when the agent 85 | is disposed). For example, [see this F# snippet][1]. 86 | 87 | * **BatchProcessingAgent** can be used to implement batch processing. It creates groups of 88 | messages (added using the `Enqueue` method) and emits them using the `BatchProduced` 89 | event. A group is produced when it reaches the maximal size or after the timeout elapses. 90 | 91 | * **BlockingQueueAgent** implements an asynchronous queue with blocking put and blocking 92 | get operations. It can be used to implement the _producer-consumer_ concurrent pattern. 93 | The constructor of the agent takes the maximal size of the buffer. 94 | 95 | 96 | Observable extensions 97 | --------------------- 98 | 99 | The library implements extensions for using `IObservable<'T>` type from F# asynchronous 100 | workflows. An overloaded extension method `Async.AwaitObservable` can be used to wait 101 | for an occurrence of an event (or other observable action): 102 | 103 | let counter n = async { 104 | printfn "Counting: %d" n 105 | let! _ = form.MouseDown |> Async.AwaitObservable 106 | return! counter (n + 1) } 107 | 108 | Overloaded version of the method allows waiting for the first of multiple events. The 109 | method asynchronously returns `Choice<'T1, 'T2>` value that can be used to determine 110 | which of the events has occurred. 111 | 112 | For examples using this method see Chapter 16 of [Real World Functional Programming][2] 113 | (some examples are available in a [free excerpt from the chapter][3]). The 114 | `Async.AwaitObservable` method should be used instead of `Async.AwaitEvent` to avoid 115 | memory leaks (see also related [StackOverflow discussion][4]) 116 | 117 | [1]: http://fssnip.net/64 118 | [2]: http://manning.com/petricek 119 | [3]: http://dotnetslackers.com/articles/net/Programming-user-interfaces-using-f-sharp-workflows.aspx 120 | [4]: http://stackoverflow.com/questions/3701861/wait-for-any-event-of-multiple-events-simultaneously-in-f 121 | [5]: http://fssnip.net/1k 122 | [6]: http://fssnip.net/1Y 123 | [7]: https://github.com/tpetricek/FSharp.AsyncExtensions 124 | -------------------------------------------------------------------------------- /samples/ChatServer.fsx: -------------------------------------------------------------------------------- 1 | #r "System.Xml.Linq.dll" 2 | //#load "Server.fs" 3 | 4 | //open System.IO 5 | //open System.Net 6 | //open System.Text 7 | //open System.Threading 8 | open System.Xml.Linq 9 | //open FSharp.Control 10 | 11 | type Agent<'T> = MailboxProcessor<'T> 12 | 13 | // ---------------------------------------------------------------------------- 14 | 15 | module First = 16 | let agent = Agent.Start(fun agent -> async { 17 | while true do 18 | let! msg = agent.Receive() 19 | printfn "Hello %s!" msg }) 20 | 21 | agent.Post("Tomas") 22 | 23 | type ChatMessage = 24 | | GetContent of AsyncReplyChannel<string> 25 | | SendMessage of string 26 | 27 | module Second = 28 | let agent = Agent<_>.Start(fun agent -> 29 | let rec loop messages = async { 30 | 31 | // Pick next message from the mailbox 32 | let! msg = agent.Receive() 33 | match msg with 34 | | SendMessage msg -> 35 | // Add message to the list & continue 36 | let msg = XElement(XName.Get("li"), msg) 37 | return! loop (msg :: messages) 38 | 39 | | GetContent reply -> 40 | // Generate HTML with messages 41 | let html = XElement(XName.Get("ul"), messages) 42 | // Send it back as the reply 43 | reply.Reply(html.ToString()) 44 | return! loop messages } 45 | loop [] ) 46 | 47 | agent.Post(SendMessage "Welcome to F# chat implemented using agents!") 48 | agent.Post(SendMessage "This is my second message to this chat room...") 49 | 50 | agent.PostAndReply(GetContent) 51 | 52 | // -------------------------------------------------------------------------------------- 53 | 54 | type internal ChatMessage = 55 | | GetContent of AsyncReplyChannel<string> 56 | | SendMessage of string 57 | 58 | 59 | type ChatRoom() = 60 | let agent = Agent.Start(fun agent -> 61 | let rec loop messages = async { 62 | // Pick next message from the mailbox 63 | let! msg = agent.Receive() 64 | match msg with 65 | | SendMessage msg -> 66 | // Add message to the list & continue 67 | let msg = XElement(XName.Get("li"), msg) 68 | return! loop (msg :: messages) 69 | 70 | | GetContent reply -> 71 | // Generate HTML with messages 72 | let html = XElement(XName.Get("ul"), messages) 73 | // Send it back as the reply 74 | reply.Reply(html.ToString()) 75 | return! loop messages } 76 | loop [] ) 77 | member x.SendMessage(msg) = agent.Post(SendMessage msg) 78 | member x.AsyncGetContent(?timeout) = agent.PostAndAsyncReply(GetContent, ?timeout=timeout) 79 | member x.GetContent() = agent.PostAndReply(GetContent) 80 | 81 | member x.GetContentAsync() = 82 | Async.StartAsTask(agent.PostAndAsyncReply(GetContent)) 83 | 84 | member x.GetContentAsync(cancellationToken) = 85 | Async.StartAsTask 86 | ( agent.PostAndAsyncReply(GetContent), 87 | cancellationToken = cancellationToken ) 88 | 89 | let room = new ChatRoom() 90 | 91 | room.SendMessage("Welcome to F# chat implemented using agents!") 92 | room.SendMessage("This is my second message to this chat room...") 93 | 94 | async { 95 | while true do 96 | do! Async.Sleep(10000) 97 | let! html = room.AsyncGetContent() 98 | printfn "%A" html } 99 | |> Async.Start 100 | 101 | // -------------------------------------------------------------------------------------- 102 | 103 | open System.Net 104 | open System.Threading 105 | 106 | [<AutoOpen>] 107 | module HttpExtensions = 108 | 109 | type System.Net.HttpListener with 110 | member x.AsyncGetContext() = 111 | Async.FromBeginEnd(x.BeginGetContext, x.EndGetContext) 112 | 113 | type HttpAgent private (url, f) as this = 114 | let tokenSource = new CancellationTokenSource() 115 | let agent = Agent.Start((fun _ -> f this), tokenSource.Token) 116 | let server = async { 117 | use listener = new HttpListener() 118 | listener.Prefixes.Add(url) 119 | listener.Start() 120 | while true do 121 | let! context = listener.AsyncGetContext() 122 | agent.Post(context) } 123 | do Async.Start(server, cancellationToken = tokenSource.Token) 124 | 125 | member x.Receive(?timeout) = agent.Receive(?timeout = timeout) 126 | member x.Stop() = tokenSource.Cancel() 127 | static member Start(url, f) = 128 | new HttpAgent(url, f) 129 | 130 | 131 | open System.IO 132 | open System.Text 133 | 134 | [<AutoOpen>] 135 | module HttpExtensions2 = 136 | 137 | type System.Net.HttpListenerRequest with 138 | member request.InputString = 139 | use sr = new StreamReader(request.InputStream) 140 | sr.ReadToEnd() 141 | 142 | type System.Net.HttpListenerResponse with 143 | member response.Reply(s:string) = 144 | let buffer = Encoding.UTF8.GetBytes(s) 145 | response.ContentLength64 <- int64 buffer.Length 146 | let output = response.OutputStream 147 | output.Write(buffer,0,buffer.Length) 148 | output.Close() 149 | member response.Reply(typ, buffer:byte[]) = 150 | response.ContentLength64 <- int64 buffer.Length 151 | let output = response.OutputStream 152 | response.ContentType <- typ 153 | output.Write(buffer,0,buffer.Length) 154 | output.Close() 155 | 156 | // -------------------------------------------------------------------------------------- 157 | 158 | open System.Threading 159 | 160 | let server = HttpAgent.Start("http://localhost:8082/", fun server -> async { 161 | while true do 162 | let! ctx = server.Receive() 163 | ctx.Response.Reply("Hello!") }) 164 | 165 | server.Stop() 166 | 167 | let root = @"C:\Tomas\Writing\MSDN\code\2 Server Side\Demo.ChatServer\" 168 | 169 | let contentTypes = 170 | dict [ ".gif", "binary/image" 171 | ".css", "text/css" 172 | ".html", "text/html" 173 | ".xap", "application/x-silverlight-app" ] 174 | 175 | let server = HttpAgent.Start("http://localhost:8082/", fun mbox -> 176 | let handleRequest (ctx:HttpListenerContext) = async { 177 | match ctx.Request.Url.LocalPath with 178 | | "/post" -> 179 | // Send message to the chat room 180 | room.SendMessage(ctx.Request.InputString) 181 | ctx.Response.Reply("OK") 182 | | "/chat" -> 183 | // Get messages from the chat room (asynchronously!) 184 | let! text = room.AsyncGetContent() 185 | ctx.Response.Reply(text) 186 | | s -> 187 | // Handle an ordinary file request 188 | let file = 189 | root + (if s = "/" then "chat.html" else s.ToLower()) 190 | if File.Exists(file) then 191 | let typ = contentTypes.[Path.GetExtension(file)] 192 | ctx.Response.Reply(typ, File.ReadAllBytes(file)) 193 | else 194 | ctx.Response.Reply(sprintf "File not found: %s" file) } 195 | async { 196 | while true do 197 | let! ctx = mbox.Receive() 198 | ctx |> handleRequest |> Async.Start }) 199 | 200 | server.Stop() 201 | -------------------------------------------------------------------------------- /samples/Crawler.fsx: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (Crawler.fsx) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | 6 | // This example demonstrates how to use asynchronous sequences and 7 | // blocking agents to implement a web crawler. The sample also uses 8 | // various AsyncSeq combinators to process the resulting async sequence. 9 | // 10 | // The first version performs single-threaded random walk (returned 11 | // as an asynchronous sequence) and the second version is concurrent. 12 | 13 | #r "..\\bin\\FSharp.AsyncExtensions.dll" 14 | #r "..\\bin\\HtmlAgilityPack.dll" 15 | 16 | open System 17 | open System.Net 18 | open System.Text.RegularExpressions 19 | open HtmlAgilityPack 20 | 21 | open FSharp.Control 22 | 23 | // ---------------------------------------------------------------------------- 24 | // Helper functions for downloading documents, extracting links etc. 25 | 26 | /// Asynchronously download the document and parse the HTML 27 | let downloadDocument url = async { 28 | try let wc = new WebClient() 29 | let! html = wc.AsyncDownloadString(Uri(url)) 30 | let doc = new HtmlDocument() 31 | doc.LoadHtml(html) 32 | return Some doc 33 | with _ -> return None } 34 | 35 | /// Extract all links from the document that start with "http://" 36 | let extractLinks (doc:HtmlDocument) = 37 | try 38 | [ for a in doc.DocumentNode.SelectNodes("//a") do 39 | if a.Attributes.Contains("href") then 40 | let href = a.Attributes.["href"].Value 41 | if href.StartsWith("http://") then 42 | let endl = href.IndexOf('?') 43 | yield if endl > 0 then href.Substring(0, endl) else href ] 44 | with _ -> [] 45 | 46 | /// Extract the <title> of the web page 47 | let getTitle (doc:HtmlDocument) = 48 | let title = doc.DocumentNode.SelectSingleNode("//title") 49 | if title <> null then title.InnerText.Trim() else "Untitled" 50 | 51 | // ---------------------------------------------------------------------------- 52 | // Basic crawling - crawl web pages and follow just one link from every page 53 | 54 | /// Crawl the internet starting from the specified page 55 | /// From each page follow the first not-yet-visited page 56 | let rec randomCrawl url = 57 | let visited = new System.Collections.Generic.HashSet<_>() 58 | 59 | // Visits page and then recursively visits all referenced pages 60 | let rec loop url = asyncSeq { 61 | if visited.Add(url) then 62 | let! doc = downloadDocument url 63 | match doc with 64 | | Some doc -> 65 | // Yield url and title as the next element 66 | yield url, getTitle doc 67 | // For every link, yield all referenced pages too 68 | for link in extractLinks doc do 69 | yield! loop link 70 | | _ -> () } 71 | loop url 72 | 73 | // Use AsyncSeq combinators to print the titles of the first 10 74 | // web sites that are from other domains than bing.com 75 | randomCrawl "http://news.bing.com" 76 | |> AsyncSeq.filter (fun (url, title) -> url.Contains("bing.com") |> not) 77 | |> AsyncSeq.map snd 78 | |> AsyncSeq.take 10 79 | |> AsyncSeq.iter (printfn "%s") 80 | |> Async.Start 81 | 82 | 83 | // ---------------------------------------------------------------------------- 84 | // Better crawler - crawls the web concurrently using the specified number of 85 | // workers, stores results and pending URLS to blocking buffers and returns 86 | // all results as an asynchronous sequence. After caller stops taking elements 87 | // from the asynchronous sequence, the blocking buffers will eventually fill 88 | // up and crawling will stop. 89 | 90 | let concurrentWorkers = 20 91 | 92 | let rec concurrentCrawl url = asyncSeq { 93 | // Number of pending requests is usually very high 94 | // (when the queue fills up, the workers will stop, so set this to 10k) 95 | let requests = BlockingQueueAgent<_>(10000) 96 | let results = BlockingQueueAgent<_>(40) 97 | let visited = ConcurrentSetAgent<_>() 98 | 99 | /// Worker repeatedly takes URL from the queue and processes it 100 | let worker() = async { 101 | while true do 102 | let! url = requests.AsyncGet() 103 | let! doc = downloadDocument url 104 | match doc with 105 | | Some doc -> 106 | // Yield url and title as the next element 107 | do! results.AsyncAdd( (url, getTitle doc) ) 108 | // For every link, yield all referenced pages too 109 | for link in extractLinks doc do 110 | let! added = visited.AsyncAdd(link) 111 | if added then 112 | do! requests.AsyncAdd(link) 113 | | _ -> () } 114 | 115 | // Return an asynchronous sequence that sends intial request 116 | // to the crawler, starts workers and then repeatedly takes 117 | // results from the results queue. 118 | do! requests.AsyncAdd(url) 119 | for i in 0 .. concurrentWorkers do 120 | worker () |> Async.Start 121 | while true do 122 | let! res = results.AsyncGet() 123 | yield res } 124 | 125 | // ---------------------------------------------------------------------------- 126 | // Visualize the results of crawling - show the most common words in titles 127 | 128 | // Create user interface with text box for displaying words 129 | open System.Windows.Forms 130 | let frm = new Form(TopMost=true, Visible=true, Width=400, Height=600) 131 | let txt = new TextBox( Multiline = true, Dock = DockStyle.Fill, 132 | Font = new System.Drawing.Font("Cambria", 12.0f), 133 | ScrollBars = ScrollBars.Vertical ) 134 | frm.Controls.Add(txt) 135 | 136 | // Creates an asynchronous sequence that produces values of type 137 | // Map<string, int> representing words together with their count 138 | // (new version returned after every processing step) 139 | let tables = 140 | concurrentCrawl "http://news.bing.com" 141 | // Split title into lowercase words 142 | |> AsyncSeq.map (fun (_, title) -> 143 | title.Split( [|' '; '.'; '-'; '|'; ','; ';' |], 144 | StringSplitOptions.RemoveEmptyEntries ) 145 | |> Array.map (fun s -> s.ToLower()) ) 146 | // Create sequence that aggregates words and returns immediate results 147 | |> AsyncSeq.scan (fun table words -> 148 | words |> Seq.fold (fun table word -> 149 | match Map.tryFind word table with 150 | | Some v -> Map.add word (v + 1) table 151 | | _ -> Map.add word 1 table) table) Map.empty 152 | 153 | // Asynchronous workflow that iterates over the sequence 154 | // and displays the results in the textbox 155 | async { 156 | let counter = ref 0 157 | for table in tables |> AsyncSeq.take 200 do 158 | frm.Text <- sprintf "Processed %d" (counter := !counter + 1; !counter) 159 | txt.Text <- 160 | table 161 | |> Seq.sortBy (fun (KeyValue(k, v)) -> -v) 162 | |> Seq.map (fun (KeyValue(k, v)) -> sprintf "%s (%d)" k v) 163 | |> String.concat "\r\n" } 164 | |> Async.StartImmediate 165 | -------------------------------------------------------------------------------- /src/Observable.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (Observable.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | #nowarn "40" 6 | namespace FSharp.Control 7 | 8 | open System 9 | open System.Threading 10 | 11 | // ---------------------------------------------------------------------------- 12 | 13 | /// Union type that represents different messages that can be sent to the 14 | /// IObserver interface. The IObserver type is equivalent to a type that has 15 | /// just OnNext method that gets 'ObservableUpdate' as an argument. 16 | type ObservableUpdate<'T> = 17 | | Next of 'T 18 | | Error of exn 19 | | Completed 20 | 21 | module Observable = 22 | 23 | /// Returns an observable that yields sliding windows of 24 | /// containing elements drawn from the input observable. 25 | /// Each window is returned as a fresh array. 26 | let windowed size (input:IObservable<'T>) = 27 | { new IObservable<'T[]> with 28 | member x.Subscribe(observer) = 29 | // Create sliding window agent for every call 30 | // and redirect batches to the observer 31 | let cts = new CancellationTokenSource() 32 | let agent = new SlidingWindowAgent<_>(size, cts.Token) 33 | agent.WindowProduced.Add(observer.OnNext) 34 | 35 | // Subscribe to the input and send values to the agent 36 | let subscription = 37 | input.Subscribe 38 | ({ new IObserver<'T> with 39 | member x.OnNext(v) = agent.Enqueue(v) 40 | member x.OnCompleted() = 41 | cts.Cancel() 42 | observer.OnCompleted() 43 | member x.OnError(e) = 44 | cts.Cancel() 45 | observer.OnError(e) }) 46 | 47 | // Cancel subscription & cancel the agent 48 | { new IDisposable with 49 | member x.Dispose() = 50 | subscription.Dispose() 51 | cts.Cancel() } } 52 | 53 | /// Creates an observable that calls the specified function (each time) 54 | /// after an observer is attached to the observable. This is useful to 55 | /// make sure that events triggered by the function are handled. 56 | let guard f (e:IObservable<'Args>) = 57 | { new IObservable<'Args> with 58 | member x.Subscribe(observer) = 59 | let rm = e.Subscribe(observer) in f(); rm } 60 | 61 | /// Turns observable into an observable that only calls OnNext method of the 62 | /// observer, but gives it a discriminated union that represents different 63 | /// kinds of events (error, next, completed) 64 | let asUpdates (input:IObservable<'T>) = 65 | { new IObservable<_> with 66 | member x.Subscribe(observer) = 67 | input.Subscribe 68 | ({ new IObserver<_> with 69 | member x.OnNext(v) = observer.OnNext(Next v) 70 | member x.OnCompleted() = observer.OnNext(Completed) 71 | member x.OnError(e) = observer.OnNext(Error e) }) } 72 | 73 | // ---------------------------------------------------------------------------- 74 | 75 | [<AutoOpen>] 76 | module ObservableExtensions = 77 | 78 | /// Helper that can be used for writing CPS-style code that resumes 79 | /// on the same thread where the operation was started. 80 | let internal synchronize f = 81 | let ctx = System.Threading.SynchronizationContext.Current 82 | f (fun g -> 83 | let nctx = System.Threading.SynchronizationContext.Current 84 | if ctx <> null && ctx <> nctx then ctx.Post((fun _ -> g()), null) 85 | else g() ) 86 | 87 | type Microsoft.FSharp.Control.Async with 88 | 89 | /// Behaves like AwaitObservable, but calls the specified guarding function 90 | /// after a subscriber is registered with the observable. 91 | static member GuardedAwaitObservable (ev1:IObservable<'T1>) guardFunction = 92 | synchronize (fun f -> 93 | Async.FromContinuations((fun (cont,econt,ccont) -> 94 | let rec finish cont value = 95 | remover.Dispose() 96 | f (fun () -> cont value) 97 | and remover : IDisposable = 98 | ev1.Subscribe 99 | ({ new IObserver<_> with 100 | member x.OnNext(v) = finish cont v 101 | member x.OnError(e) = finish econt e 102 | member x.OnCompleted() = 103 | let msg = "Cancelling the workflow, because the Observable awaited using AwaitObservable has completed." 104 | finish ccont (new System.OperationCanceledException(msg)) }) 105 | guardFunction() ))) 106 | 107 | /// Creates an asynchronous workflow that will be resumed when the 108 | /// specified observables produces a value. The workflow will return 109 | /// the value produced by the observable. 110 | static member AwaitObservable(ev1:IObservable<'T1>) = 111 | synchronize (fun f -> 112 | Async.FromContinuations((fun (cont,econt,ccont) -> 113 | let rec finish cont value = 114 | remover.Dispose() 115 | f (fun () -> cont value) 116 | and remover : IDisposable = 117 | ev1.Subscribe 118 | ({ new IObserver<_> with 119 | member x.OnNext(v) = finish cont v 120 | member x.OnError(e) = finish econt e 121 | member x.OnCompleted() = 122 | let msg = "Cancelling the workflow, because the Observable awaited using AwaitObservable has completed." 123 | finish ccont (new System.OperationCanceledException(msg)) }) 124 | () ))) 125 | 126 | /// Creates an asynchronous workflow that will be resumed when the 127 | /// first of the specified two observables produces a value. The 128 | /// workflow will return a Choice value that can be used to identify 129 | /// the observable that produced the value. 130 | static member AwaitObservable(ev1:IObservable<'T1>, ev2:IObservable<'T2>) = 131 | List.reduce Observable.merge 132 | [ ev1 |> Observable.map Choice1Of2 133 | ev2 |> Observable.map Choice2Of2 ] 134 | |> Async.AwaitObservable 135 | 136 | /// Creates an asynchronous workflow that will be resumed when the 137 | /// first of the specified three observables produces a value. The 138 | /// workflow will return a Choice value that can be used to identify 139 | /// the observable that produced the value. 140 | static member AwaitObservable 141 | ( ev1:IObservable<'T1>, ev2:IObservable<'T2>, ev3:IObservable<'T3> ) = 142 | List.reduce Observable.merge 143 | [ ev1 |> Observable.map Choice1Of3 144 | ev2 |> Observable.map Choice2Of3 145 | ev3 |> Observable.map Choice3Of3 ] 146 | |> Async.AwaitObservable 147 | 148 | /// Creates an asynchronous workflow that will be resumed when the 149 | /// first of the specified four observables produces a value. The 150 | /// workflow will return a Choice value that can be used to identify 151 | /// the observable that produced the value. 152 | static member AwaitObservable( ev1:IObservable<'T1>, ev2:IObservable<'T2>, 153 | ev3:IObservable<'T3>, ev4:IObservable<'T4> ) = 154 | List.reduce Observable.merge 155 | [ ev1 |> Observable.map Choice1Of4 156 | ev2 |> Observable.map Choice2Of4 157 | ev3 |> Observable.map Choice3Of4 158 | ev4 |> Observable.map Choice4Of4 ] 159 | |> Async.AwaitObservable 160 | -------------------------------------------------------------------------------- /License.markdown: -------------------------------------------------------------------------------- 1 | Apache License, Version 2.0 2 | =========================== 3 | 4 | Apache License 5 | Version 2.0, January 2004 6 | http://www.apache.org/licenses/ 7 | 8 | ------------------------------------------------------------ 9 | 10 | ### TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 11 | 12 | 13 | **1. Definitions.** 14 | 15 | - "License" shall mean the terms and conditions for use, reproduction, 16 | and distribution as defined by Sections 1 through 9 of this document. 17 | 18 | - "Licensor" shall mean the copyright owner or entity authorized by 19 | the copyright owner that is granting the License. 20 | 21 | - "Legal Entity" shall mean the union of the acting entity and all 22 | other entities that control, are controlled by, or are under common 23 | control with that entity. For the purposes of this definition, 24 | "control" means (i) the power, direct or indirect, to cause the 25 | direction or management of such entity, whether by contract or 26 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 27 | outstanding shares, or (iii) beneficial ownership of such entity. 28 | 29 | - "You" (or "Your") shall mean an individual or Legal Entity 30 | exercising permissions granted by this License. 31 | 32 | - "Source" form shall mean the preferred form for making modifications, 33 | including but not limited to software source code, documentation 34 | source, and configuration files. 35 | 36 | - "Object" form shall mean any form resulting from mechanical 37 | transformation or translation of a Source form, including but 38 | not limited to compiled object code, generated documentation, 39 | and conversions to other media types. 40 | 41 | - "Work" shall mean the work of authorship, whether in Source or 42 | Object form, made available under the License, as indicated by a 43 | copyright notice that is included in or attached to the work 44 | (an example is provided in the Appendix below). 45 | 46 | - "Derivative Works" shall mean any work, whether in Source or Object 47 | form, that is based on (or derived from) the Work and for which the 48 | editorial revisions, annotations, elaborations, or other modifications 49 | represent, as a whole, an original work of authorship. For the purposes 50 | of this License, Derivative Works shall not include works that remain 51 | separable from, or merely link (or bind by name) to the interfaces of, 52 | the Work and Derivative Works thereof. 53 | 54 | - "Contribution" shall mean any work of authorship, including 55 | the original version of the Work and any modifications or additions 56 | to that Work or Derivative Works thereof, that is intentionally 57 | submitted to Licensor for inclusion in the Work by the copyright owner 58 | or by an individual or Legal Entity authorized to submit on behalf of 59 | the copyright owner. For the purposes of this definition, "submitted" 60 | means any form of electronic, verbal, or written communication sent 61 | to the Licensor or its representatives, including but not limited to 62 | communication on electronic mailing lists, source code control systems, 63 | and issue tracking systems that are managed by, or on behalf of, the 64 | Licensor for the purpose of discussing and improving the Work, but 65 | excluding communication that is conspicuously marked or otherwise 66 | designated in writing by the copyright owner as "Not a Contribution." 67 | 68 | - "Contributor" shall mean Licensor and any individual or Legal Entity 69 | on behalf of whom a Contribution has been received by Licensor and 70 | subsequently incorporated within the Work. 71 | 72 | **2. Grant of Copyright License.** 73 | Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | copyright license to reproduce, prepare Derivative Works of, 77 | publicly display, publicly perform, sublicense, and distribute the 78 | Work and such Derivative Works in Source or Object form. 79 | 80 | **3. Grant of Patent License.** 81 | Subject to the terms and conditions of 82 | this License, each Contributor hereby grants to You a perpetual, 83 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 84 | (except as stated in this section) patent license to make, have made, 85 | use, offer to sell, sell, import, and otherwise transfer the Work, 86 | where such license applies only to those patent claims licensable 87 | by such Contributor that are necessarily infringed by their 88 | Contribution(s) alone or by combination of their Contribution(s) 89 | with the Work to which such Contribution(s) was submitted. If You 90 | institute patent litigation against any entity (including a 91 | cross-claim or counterclaim in a lawsuit) alleging that the Work 92 | or a Contribution incorporated within the Work constitutes direct 93 | or contributory patent infringement, then any patent licenses 94 | granted to You under this License for that Work shall terminate 95 | as of the date such litigation is filed. 96 | 97 | **4. Redistribution.** 98 | You may reproduce and distribute copies of the 99 | Work or Derivative Works thereof in any medium, with or without 100 | modifications, and in Source or Object form, provided that You 101 | meet the following conditions: 102 | 103 | - You must give any other recipients of the Work or 104 | Derivative Works a copy of this License; and 105 | 106 | - You must cause any modified files to carry prominent notices 107 | stating that You changed the files; and 108 | 109 | - You must retain, in the Source form of any Derivative Works 110 | that You distribute, all copyright, patent, trademark, and 111 | attribution notices from the Source form of the Work, 112 | excluding those notices that do not pertain to any part of 113 | the Derivative Works; and 114 | 115 | - If the Work includes a "NOTICE" text file as part of its 116 | distribution, then any Derivative Works that You distribute must 117 | include a readable copy of the attribution notices contained 118 | within such NOTICE file, excluding those notices that do not 119 | pertain to any part of the Derivative Works, in at least one 120 | of the following places: within a NOTICE text file distributed 121 | as part of the Derivative Works; within the Source form or 122 | documentation, if provided along with the Derivative Works; or, 123 | within a display generated by the Derivative Works, if and 124 | wherever such third-party notices normally appear. The contents 125 | of the NOTICE file are for informational purposes only and 126 | do not modify the License. You may add Your own attribution 127 | notices within Derivative Works that You distribute, alongside 128 | or as an addendum to the NOTICE text from the Work, provided 129 | that such additional attribution notices cannot be construed 130 | as modifying the License. 131 | 132 | You may add Your own copyright statement to Your modifications and 133 | may provide additional or different license terms and conditions 134 | for use, reproduction, or distribution of Your modifications, or 135 | for any such Derivative Works as a whole, provided Your use, 136 | reproduction, and distribution of the Work otherwise complies with 137 | the conditions stated in this License. 138 | 139 | **5. Submission of Contributions.** 140 | Unless You explicitly state otherwise, 141 | any Contribution intentionally submitted for inclusion in the Work 142 | by You to the Licensor shall be under the terms and conditions of 143 | this License, without any additional terms or conditions. 144 | Notwithstanding the above, nothing herein shall supersede or modify 145 | the terms of any separate license agreement you may have executed 146 | with Licensor regarding such Contributions. 147 | 148 | **6. Trademarks.** 149 | This License does not grant permission to use the trade 150 | names, trademarks, service marks, or product names of the Licensor, 151 | except as required for reasonable and customary use in describing the 152 | origin of the Work and reproducing the content of the NOTICE file. 153 | 154 | **7. Disclaimer of Warranty.** 155 | Unless required by applicable law or 156 | agreed to in writing, Licensor provides the Work (and each 157 | Contributor provides its Contributions) on an "AS IS" BASIS, 158 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 159 | implied, including, without limitation, any warranties or conditions 160 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 161 | PARTICULAR PURPOSE. You are solely responsible for determining the 162 | appropriateness of using or redistributing the Work and assume any 163 | risks associated with Your exercise of permissions under this License. 164 | 165 | **8. Limitation of Liability.** 166 | In no event and under no legal theory, 167 | whether in tort (including negligence), contract, or otherwise, 168 | unless required by applicable law (such as deliberate and grossly 169 | negligent acts) or agreed to in writing, shall any Contributor be 170 | liable to You for damages, including any direct, indirect, special, 171 | incidental, or consequential damages of any character arising as a 172 | result of this License or out of the use or inability to use the 173 | Work (including but not limited to damages for loss of goodwill, 174 | work stoppage, computer failure or malfunction, or any and all 175 | other commercial damages or losses), even if such Contributor 176 | has been advised of the possibility of such damages. 177 | 178 | **9. Accepting Warranty or Additional Liability.** 179 | While redistributing 180 | the Work or Derivative Works thereof, You may choose to offer, 181 | and charge a fee for, acceptance of support, warranty, indemnity, 182 | or other liability obligations and/or rights consistent with this 183 | License. However, in accepting such obligations, You may act only 184 | on Your own behalf and on Your sole responsibility, not on behalf 185 | of any other Contributor, and only if You agree to indemnify, 186 | defend, and hold each Contributor harmless for any liability 187 | incurred by, or claims asserted against, such Contributor by reason 188 | of your accepting any such warranty or additional liability. 189 | -------------------------------------------------------------------------------- /src/AsyncSeq.fs: -------------------------------------------------------------------------------- 1 | // ---------------------------------------------------------------------------- 2 | // F# async extensions (AsyncSeq.fs) 3 | // (c) Tomas Petricek, 2011, Available under Apache 2.0 license. 4 | // ---------------------------------------------------------------------------- 5 | namespace FSharp.Control 6 | 7 | open System 8 | open System.Threading 9 | open System.IO 10 | 11 | // ---------------------------------------------------------------------------- 12 | 13 | /// An asynchronous sequence represents a delayed computation that can be 14 | /// started to produce either Cons value consisting of the next element of the 15 | /// sequence (head) together with the next asynchronous sequence (tail) or a 16 | /// special value representing the end of the sequence (Nil) 17 | type AsyncSeq<'T> = Async<AsyncSeqInner<'T>> 18 | 19 | /// The interanl type that represents a value returned as a result of 20 | /// evaluating a step of an asynchronous sequence 21 | and AsyncSeqInner<'T> = 22 | | Nil 23 | | Cons of 'T * AsyncSeq<'T> 24 | 25 | 26 | /// Module with helper functions for working with asynchronous sequences 27 | module AsyncSeq = 28 | 29 | /// Creates an empty asynchronou sequence that immediately ends 30 | [<GeneralizableValue>] 31 | let empty<'T> : AsyncSeq<'T> = 32 | async { return Nil } 33 | 34 | /// Creates an asynchronous sequence that generates a single element and then ends 35 | let singleton (v:'T) : AsyncSeq<'T> = 36 | async { return Cons(v, empty) } 37 | 38 | /// Yields all elements of the first asynchronous sequence and then 39 | /// all elements of the second asynchronous sequence. 40 | let rec append (seq1: AsyncSeq<'T>) (seq2: AsyncSeq<'T>) : AsyncSeq<'T> = 41 | async { let! v1 = seq1 42 | match v1 with 43 | | Nil -> return! seq2 44 | | Cons (h,t) -> return Cons(h,append t seq2) } 45 | 46 | 47 | /// Computation builder that allows creating of asynchronous 48 | /// sequences using the 'asyncSeq { ... }' syntax 49 | type AsyncSeqBuilder() = 50 | member x.Yield(v) = singleton v 51 | // This looks weird, but it is needed to allow: 52 | // 53 | // while foo do 54 | // do! something 55 | // 56 | // because F# translates body as Bind(something, fun () -> Return()) 57 | member x.Return(()) = empty 58 | member x.YieldFrom(s) = s 59 | member x.Zero () = empty 60 | member x.Bind (inp:Async<'T>, body : 'T -> AsyncSeq<'U>) : AsyncSeq<'U> = 61 | async.Bind(inp, body) 62 | member x.Combine (seq1:AsyncSeq<'T>,seq2:AsyncSeq<'T>) = 63 | append seq1 seq2 64 | member x.While (gd, seq:AsyncSeq<'T>) = 65 | if gd() then x.Combine(seq,x.Delay(fun () -> x.While (gd, seq))) else x.Zero() 66 | member x.Delay (f:unit -> AsyncSeq<'T>) = 67 | async.Delay(f) 68 | 69 | 70 | /// Builds an asynchronou sequence using the computation builder syntax 71 | let asyncSeq = new AsyncSeqBuilder() 72 | 73 | /// Tries to get the next element of an asynchronous sequence 74 | /// and returns either the value or an exception 75 | let internal tryNext (input:AsyncSeq<_>) = async { 76 | try 77 | let! v = input 78 | return Choice1Of2 v 79 | with e -> 80 | return Choice2Of2 e } 81 | 82 | /// Implements the 'TryWith' functionality for computation builder 83 | let rec internal tryWith (input : AsyncSeq<'T>) handler = asyncSeq { 84 | let! v = tryNext input 85 | match v with 86 | | Choice1Of2 Nil -> () 87 | | Choice1Of2 (Cons (h, t)) -> 88 | yield h 89 | yield! tryWith t handler 90 | | Choice2Of2 rest -> 91 | yield! handler rest } 92 | 93 | /// Implements the 'TryFinally' functionality for computation builder 94 | let rec internal tryFinally (input : AsyncSeq<'T>) compensation = asyncSeq { 95 | let! v = tryNext input 96 | match v with 97 | | Choice1Of2 Nil -> 98 | compensation() 99 | | Choice1Of2 (Cons (h, t)) -> 100 | yield h 101 | yield! tryFinally t compensation 102 | | Choice2Of2 e -> 103 | compensation() 104 | yield! raise e } 105 | 106 | /// Creates an asynchronou sequence that iterates over the given input sequence. 107 | /// For every input element, it calls the the specified function and iterates 108 | /// over all elements generated by that asynchronous sequence. 109 | /// This is the 'bind' operation of the computation expression (exposed using 110 | /// the 'for' keyword in asyncSeq computation). 111 | let rec collect f (input : AsyncSeq<'T>) : AsyncSeq<'TResult> = asyncSeq { 112 | let! v = input 113 | match v with 114 | | Nil -> () 115 | | Cons(h, t) -> 116 | yield! f h 117 | yield! collect f t } 118 | 119 | 120 | // Add additional methods to the 'asyncSeq' computation builder 121 | type AsyncSeqBuilder with 122 | member x.TryFinally (body: AsyncSeq<'T>, compensation) = 123 | tryFinally body compensation 124 | member x.TryWith (body: AsyncSeq<_>, handler: (exn -> AsyncSeq<_>)) = 125 | tryWith body handler 126 | member x.Using (resource:#IDisposable, binder) = 127 | tryFinally (binder resource) (fun () -> 128 | if box resource <> null then resource.Dispose()) 129 | 130 | /// For loop that iterates over a synchronous sequence (and generates 131 | /// all elements generated by the asynchronous body) 132 | member x.For(seq:seq<'T>, action:'T -> AsyncSeq<'TResult>) = 133 | let enum = seq.GetEnumerator() 134 | x.TryFinally(x.While((fun () -> enum.MoveNext()), x.Delay(fun () -> 135 | action enum.Current)), (fun () -> 136 | if enum <> null then enum.Dispose() )) 137 | 138 | /// Asynchronous for loop - for all elements from the input sequence, 139 | /// generate all elements produced by the body (asynchronously). See 140 | /// also the AsyncSeq.collect function. 141 | member x.For (seq:AsyncSeq<'T>, action:'T -> AsyncSeq<'TResult>) = 142 | collect action seq 143 | 144 | 145 | // Add asynchronous for loop to the 'async' computation builder 146 | type Microsoft.FSharp.Control.AsyncBuilder with 147 | member x.For (seq:AsyncSeq<'T>, action:'T -> Async<unit>) = 148 | async.Bind(seq, function 149 | | Nil -> async.Zero() 150 | | Cons(h, t) -> async.Combine(action h, x.For(t, action))) 151 | 152 | // -------------------------------------------------------------------------- 153 | // Additional combinators (implemented as async/asyncSeq computations) 154 | 155 | /// Builds a new asynchronous sequence whose elements are generated by 156 | /// applying the specified function to all elements of the input sequence. 157 | /// 158 | /// The specified function is asynchronous (and the input sequence will 159 | /// be asked for the next element after the processing of an element completes). 160 | let mapAsync f (input : AsyncSeq<'T>) : AsyncSeq<'TResult> = asyncSeq { 161 | for itm in input do 162 | let! v = f itm 163 | yield v } 164 | 165 | /// Asynchronously iterates over the input sequence and generates 'x' for 166 | /// every input element for which the specified asynchronous function 167 | /// returned 'Some(x)' 168 | /// 169 | /// The specified function is asynchronous (and the input sequence will 170 | /// be asked for the next element after the processing of an element completes). 171 | let chooseAsync f (input : AsyncSeq<'T>) : AsyncSeq<'R> = asyncSeq { 172 | for itm in input do 173 | let! v = f itm 174 | match v with 175 | | Some v -> yield v 176 | | _ -> () } 177 | 178 | /// Builds a new asynchronous sequence whose elements are those from the 179 | /// input sequence for which the specified function returned true. 180 | /// 181 | /// The specified function is asynchronous (and the input sequence will 182 | /// be asked for the next element after the processing of an element completes). 183 | let filterAsync f (input : AsyncSeq<'T>) = asyncSeq { 184 | for v in input do 185 | let! b = f v 186 | if b then yield v } 187 | 188 | /// Asynchronously returns the last element that was generated by the 189 | /// given asynchronous sequence (or the specified default value). 190 | let rec lastOrDefault def (input : AsyncSeq<'T>) = async { 191 | let! v = input 192 | match v with 193 | | Nil -> return def 194 | | Cons(h, t) -> return! lastOrDefault h t } 195 | 196 | /// Asynchronously returns the first element that was generated by the 197 | /// given asynchronous sequence (or the specified default value). 198 | let firstOrDefault def (input : AsyncSeq<'T>) = async { 199 | let! v = input 200 | match v with 201 | | Nil -> return def 202 | | Cons(h, _) -> return h } 203 | 204 | /// Aggregates the elements of the input asynchronous sequence using the 205 | /// specified 'aggregation' function. The result is an asynchronous 206 | /// sequence of intermediate aggregation result. 207 | /// 208 | /// The aggregation function is asynchronous (and the input sequence will 209 | /// be asked for the next element after the processing of an element completes). 210 | let rec scanAsync f (state:'TState) (input : AsyncSeq<'T>) = asyncSeq { 211 | let! v = input 212 | match v with 213 | | Nil -> () 214 | | Cons(h, t) -> 215 | let! v = f state h 216 | yield v 217 | yield! t |> scanAsync f v } 218 | 219 | /// Iterates over the input sequence and calls the specified function for 220 | /// every value (to perform some side-effect asynchronously). 221 | /// 222 | /// The specified function is asynchronous (and the input sequence will 223 | /// be asked for the next element after the processing of an element completes). 224 | let rec iterAsync f (input : AsyncSeq<'T>) = async { 225 | for itm in input do 226 | do! f itm } 227 | 228 | /// Returns an asynchronous sequence that returns pairs containing an element 229 | /// from the input sequence and its predecessor. Empty sequence is returned for 230 | /// singleton input sequence. 231 | let rec pairwise (input : AsyncSeq<'T>) = asyncSeq { 232 | let! v = input 233 | match v with 234 | | Nil -> () 235 | | Cons(h, t) -> 236 | let prev = ref h 237 | for v in t do 238 | yield (!prev, v) 239 | prev := v } 240 | 241 | /// Aggregates the elements of the input asynchronous sequence using the 242 | /// specified 'aggregation' function. The result is an asynchronous 243 | /// workflow that returns the final result. 244 | /// 245 | /// The aggregation function is asynchronous (and the input sequence will 246 | /// be asked for the next element after the processing of an element completes). 247 | let rec foldAsync f (state:'TState) (input : AsyncSeq<'T>) = 248 | input |> scanAsync f state |> lastOrDefault state 249 | 250 | /// Same as AsyncSeq.foldAsync, but the specified function is synchronous 251 | /// and returns the result of aggregation immediately. 252 | let rec fold f (state:'TState) (input : AsyncSeq<'T>) = 253 | foldAsync (fun st v -> f st v |> async.Return) state input 254 | 255 | /// Same as AsyncSeq.scanAsync, but the specified function is synchronous 256 | /// and returns the result of aggregation immediately. 257 | let rec scan f (state:'TState) (input : AsyncSeq<'T>) = 258 | scanAsync (fun st v -> f st v |> async.Return) state input 259 | 260 | /// Same as AsyncSeq.mapAsync, but the specified function is synchronous 261 | /// and returns the result of projection immediately. 262 | let map f (input : AsyncSeq<'T>) = 263 | mapAsync (f >> async.Return) input 264 | 265 | /// Same as AsyncSeq.iterAsync, but the specified function is synchronous 266 | /// and performs the side-effect immediately. 267 | let iter f (input : AsyncSeq<'T>) = 268 | iterAsync (f >> async.Return) input 269 | 270 | /// Same as AsyncSeq.chooseAsync, but the specified function is synchronous 271 | /// and processes the input element immediately. 272 | let choose f (input : AsyncSeq<'T>) = 273 | chooseAsync (f >> async.Return) input 274 | 275 | /// Same as AsyncSeq.filterAsync, but the specified predicate is synchronous 276 | /// and processes the input element immediately. 277 | let filter f (input : AsyncSeq<'T>) = 278 | filterAsync (f >> async.Return) input 279 | 280 | // -------------------------------------------------------------------------- 281 | // Converting from/to synchronous sequences or IObservables 282 | 283 | /// Creates an asynchronous sequence that lazily takes element from an 284 | /// input synchronous sequence and returns them one-by-one. 285 | let ofSeq (input : seq<'T>) = asyncSeq { 286 | for el in input do 287 | yield el } 288 | 289 | /// A helper type for implementation of buffering when converting 290 | /// observable to an asynchronous sequence 291 | type internal BufferMessage<'T> = 292 | | Get of AsyncReplyChannel<'T> 293 | | Put of 'T 294 | 295 | /// Converts observable to an asynchronous sequence using an agent with 296 | /// a body specified as the argument. The returnd async sequence repeatedly 297 | /// sends 'Get' message to the agent to get the next element. The observable 298 | /// sends 'Put' message to the agent (as new inputs are generated). 299 | let internal ofObservableUsingAgent (input : System.IObservable<_>) f = 300 | asyncSeq { 301 | use agent = AutoCancelAgent.Start(f) 302 | use d = input |> Observable.asUpdates 303 | |> Observable.subscribe (Put >> agent.Post) 304 | 305 | let rec loop() = asyncSeq { 306 | let! msg = agent.PostAndAsyncReply(Get) 307 | match msg with 308 | | ObservableUpdate.Error e -> raise e 309 | | ObservableUpdate.Completed -> () 310 | | ObservableUpdate.Next v -> 311 | yield v 312 | yield! loop() } 313 | yield! loop() } 314 | 315 | /// Converts observable to an asynchronous sequence. Values that are produced 316 | /// by the observable while the asynchronous sequence is blocked are stored to 317 | /// an unbounded buffer and are returned as next elements of the async sequence. 318 | let ofObservableBuffered (input : System.IObservable<_>) = 319 | ofObservableUsingAgent input (fun mbox -> async { 320 | let buffer = new System.Collections.Generic.Queue<_>() 321 | let repls = new System.Collections.Generic.Queue<_>() 322 | while true do 323 | // Receive next message (when observable ends, caller will 324 | // cancel the agent, so we need timeout to allow cancleation) 325 | let! msg = mbox.TryReceive(200) 326 | match msg with 327 | | Some(Put(v)) -> buffer.Enqueue(v) 328 | | Some(Get(repl)) -> repls.Enqueue(repl) 329 | | _ -> () 330 | // Process matching calls from buffers 331 | while buffer.Count > 0 && repls.Count > 0 do 332 | repls.Dequeue().Reply(buffer.Dequeue()) }) 333 | 334 | 335 | /// Converts observable to an asynchronous sequence. Values that are produced 336 | /// by the observable while the asynchronous sequence is blocked are discarded 337 | /// (this function doesn't guarantee that asynchronou ssequence will return 338 | /// all values produced by the observable) 339 | let ofObservable (input : System.IObservable<_>) = 340 | ofObservableUsingAgent input (fun mbox -> async { 341 | while true do 342 | // Allow timeout (when the observable ends, caller will 343 | // cancel the agent, so we need timeout to allow cancellation) 344 | let! msg = mbox.TryReceive(200) 345 | match msg with 346 | | Some(Put _) | None -> 347 | () // Ignore put or no message 348 | | Some(Get repl) -> 349 | // Reader is blocked, so next will be Put 350 | // (caller will not stop the agent at this point, 351 | // so timeout is not necessary) 352 | let! v = mbox.Receive() 353 | match v with 354 | | Put v -> repl.Reply(v) 355 | | _ -> failwith "Unexpected Get" }) 356 | 357 | /// Converts asynchronous sequence to an IObservable<_>. When the client subscribes 358 | /// to the observable, a new copy of asynchronous sequence is started and is 359 | /// sequentially iterated over (at the maximal possible speed). Disposing of the 360 | /// observer cancels the iteration over asynchronous sequence. 361 | let toObservable (aseq:AsyncSeq<_>) = 362 | let start (obs:IObserver<_>) = 363 | async { 364 | try 365 | for v in aseq do obs.OnNext(v) 366 | obs.OnCompleted() 367 | with e -> 368 | obs.OnError(e) } 369 | |> Async.StartDisposable 370 | { new IObservable<_> with 371 | member x.Subscribe(obs) = start obs } 372 | 373 | /// Converts asynchronous sequence to a synchronous blocking sequence. 374 | /// The elements of the asynchronous sequence are consumed lazily. 375 | let toBlockingSeq (input : AsyncSeq<'T>) = 376 | // Write all elements to a blocking buffer and then add None to denote end 377 | let buf = new BlockingQueueAgent<_>(1) 378 | async { 379 | do! iterAsync (Some >> buf.AsyncAdd) input 380 | do! buf.AsyncAdd(None) } |> Async.Start 381 | 382 | // Read elements from the blocking buffer & return a sequences 383 | let rec loop () = seq { 384 | match buf.Get() with 385 | | None -> () 386 | | Some v -> 387 | yield v 388 | yield! loop() } 389 | loop () 390 | 391 | /// Create a new asynchronous sequence that caches all elements of the 392 | /// sequence specified as the input. When accessing the resulting sequence 393 | /// multiple times, the input will still be evaluated only once 394 | let rec cache (input : AsyncSeq<'T>) = 395 | let agent = Agent<AsyncReplyChannel<_>>.Start(fun agent -> async { 396 | let! repl = agent.Receive() 397 | let! next = input 398 | let res = 399 | match next with 400 | | Nil -> Nil 401 | | Cons(h, t) -> Cons(h, cache t) 402 | repl.Reply(res) 403 | while true do 404 | let! repl = agent.Receive() 405 | repl.Reply(res) }) 406 | async { return! agent.PostAndAsyncReply(id) } 407 | 408 | // -------------------------------------------------------------------------- 409 | 410 | /// Combines two asynchronous sequences into a sequence of pairs. 411 | /// The values from sequences are retrieved in parallel. 412 | let rec zip (input1 : AsyncSeq<'T1>) (input2 : AsyncSeq<'T2>) : AsyncSeq<_> = async { 413 | let! ft = input1 |> Async.StartChild 414 | let! s = input2 415 | let! f = ft 416 | match f, s with 417 | | Cons(hf, tf), Cons(hs, ts) -> 418 | return Cons( (hf, hs), zip tf ts) 419 | | _ -> return Nil } 420 | 421 | /// Returns elements from an asynchronous sequence while the specified 422 | /// predicate holds. The predicate is evaluated asynchronously. 423 | let rec takeWhileAsync p (input : AsyncSeq<'T>) : AsyncSeq<_> = async { 424 | let! v = input 425 | match v with 426 | | Cons(h, t) -> 427 | let! res = p h 428 | if res then 429 | return Cons(h, takeWhileAsync p t) 430 | else return Nil 431 | | Nil -> return Nil } 432 | 433 | /// Skips elements from an asynchronous sequence while the specified 434 | /// predicate holds and then returns the rest of the sequence. The 435 | /// predicate is evaluated asynchronously. 436 | let rec skipWhileAsync p (input : AsyncSeq<'T>) : AsyncSeq<_> = async { 437 | let! v = input 438 | match v with 439 | | Cons(h, t) -> 440 | let! res = p h 441 | if res then return! skipWhileAsync p t 442 | else return! t 443 | | Nil -> return Nil } 444 | 445 | /// Returns elements from an asynchronous sequence while the specified 446 | /// predicate holds. The predicate is evaluated synchronously. 447 | let rec takeWhile p (input : AsyncSeq<'T>) = 448 | takeWhileAsync (p >> async.Return) input 449 | 450 | /// Skips elements from an asynchronous sequence while the specified 451 | /// predicate holds and then returns the rest of the sequence. The 452 | /// predicate is evaluated asynchronously. 453 | let rec skipWhile p (input : AsyncSeq<'T>) = 454 | skipWhileAsync (p >> async.Return) input 455 | 456 | /// Returns the first N elements of an asynchronous sequence 457 | let rec take count (input : AsyncSeq<'T>) : AsyncSeq<_> = async { 458 | if count > 0 then 459 | let! v = input 460 | match v with 461 | | Cons(h, t) -> 462 | return Cons(h, take (count - 1) t) 463 | | Nil -> return Nil 464 | else return Nil } 465 | 466 | /// Skips the first N elements of an asynchronous sequence and 467 | /// then returns the rest of the sequence unmodified. 468 | let rec skip count (input : AsyncSeq<'T>) : AsyncSeq<_> = async { 469 | if count > 0 then 470 | let! v = input 471 | match v with 472 | | Cons(h, t) -> 473 | return! skip (count - 1) t 474 | | Nil -> return Nil 475 | else return! input } 476 | 477 | [<AutoOpen>] 478 | module AsyncSeqExtensions = 479 | /// Builds an asynchronou sequence using the computation builder syntax 480 | let asyncSeq = new AsyncSeq.AsyncSeqBuilder() 481 | 482 | // Add asynchronous for loop to the 'async' computation builder 483 | type Microsoft.FSharp.Control.AsyncBuilder with 484 | member x.For (seq:AsyncSeq<'T>, action:'T -> Async<unit>) = 485 | async.Bind(seq, function 486 | | Nil -> async.Zero() 487 | | Cons(h, t) -> async.Combine(action h, x.For(t, action))) 488 | 489 | module Seq = 490 | open FSharp.Control 491 | 492 | /// Converts asynchronous sequence to a synchronous blocking sequence. 493 | /// The elements of the asynchronous sequence are consumed lazily. 494 | let ofAsyncSeq (input : AsyncSeq<'T>) = 495 | AsyncSeq.toBlockingSeq input 496 | --------------------------------------------------------------------------------