From a076af380cc7027fe969cd0ee7a7e9672951fca5 Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Wed, 17 Feb 2021 19:07:25 +0000 Subject: [PATCH] Format with Fantomas, and add MIT licence --- .editorconfig | 13 ++ LICENSE | 21 +++ PulsingServer/ExternalInfoProvider.fs | 26 ++-- PulsingServer/ServerAgent.fs | 9 +- SampleApplication/Program.fs | 8 +- SampleApplication/Startup.fs | 182 +++++++++++++++----------- Test/PropertyBasedTests.fs | 36 ----- Test/TestServer.fs | 118 ++++++++++------- test.fsx | 16 +-- 9 files changed, 241 insertions(+), 188 deletions(-) create mode 100644 .editorconfig create mode 100644 LICENSE delete mode 100644 Test/PropertyBasedTests.fs diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..759eaf8 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,13 @@ +root = true + +[*.fs] +fsharp_space_before_uppercase_invocation=true +fsharp_space_before_member=true +fsharp_space_before_parameter=true +fsharp_space_before_colon=true +fsharp_space_before_semicolon=true +fsharp_multiline_block_brackets_on_same_column=true +fsharp_newline_between_type_definition_and_members=true +fsharp_keep_if_then_in_same_line=true +fsharp_align_function_signature_to_indentation=true +fsharp_alternative_long_member_definitions=true diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..7bbcda3 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2021 Patrick Stevens + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/PulsingServer/ExternalInfoProvider.fs b/PulsingServer/ExternalInfoProvider.fs index 39b83f9..ee8ffdd 100644 --- a/PulsingServer/ExternalInfoProvider.fs +++ b/PulsingServer/ExternalInfoProvider.fs @@ -11,9 +11,7 @@ type private ExternalInfoProviderMessage<'info> = /// An entity which periodically pulls information from some external source /// and pushes it out to a collection of ServerAgents. -type ExternalInfoProvider<'info> = - private - | ExternalInfoProvider of MailboxProcessor> +type ExternalInfoProvider<'info> = private ExternalInfoProvider of MailboxProcessor> [] module ExternalInfoProvider = @@ -29,14 +27,18 @@ module ExternalInfoProvider = (receivers : ServerAgent<'info> array) : Async> = - let rec loop (info : 'info option) (receivers : ServerAgent<'info> array) (mailbox : MailboxProcessor>) = + let rec loop + (info : 'info option) + (receivers : ServerAgent<'info> array) + (mailbox : MailboxProcessor>) + = async { match! mailbox.Receive () with | Get (channel, timeout) -> let! newInfo = get + match info with - | Some info when newInfo = info -> - () + | Some info when newInfo = info -> () | _ -> do! receivers @@ -46,8 +48,8 @@ module ExternalInfoProvider = match channel with | None -> () - | Some channel -> - channel.Reply () + | Some channel -> channel.Reply () + do! sleep (TimeSpan.FromMilliseconds (float timeout)) // There's a small inaccuracy here. We actually will wait until the end // of a timeout cycle before we can process any new consumers. What we @@ -63,11 +65,11 @@ module ExternalInfoProvider = } async { - let mailbox = MailboxProcessor.Start (loop None receivers) + let mailbox = + MailboxProcessor.Start (loop None receivers) + do! mailbox.PostAndAsyncReply (fun channel -> Get (Some channel, timer)) - return - mailbox - |> ExternalInfoProvider + return mailbox |> ExternalInfoProvider } /// Replace the collection of ServerAgents this ExternalInfoProvider is hooked up to. diff --git a/PulsingServer/ServerAgent.fs b/PulsingServer/ServerAgent.fs index a51771a..233b24f 100644 --- a/PulsingServer/ServerAgent.fs +++ b/PulsingServer/ServerAgent.fs @@ -4,7 +4,7 @@ type private ServerAgentMessage<'info> = | Read of AsyncReplyChannel * ('info -> unit) | Write of AsyncReplyChannel * 'info -type ServerAgent<'info> = private | ServerAgent of MailboxProcessor> +type ServerAgent<'info> = private ServerAgent of MailboxProcessor> [] module ServerAgent = @@ -39,8 +39,11 @@ module ServerAgent = /// the async returns once the ServerAgent has finished responding. let giveNextResponse<'info> (ServerAgent agent) : Async<'info> = let mutable answer = Unchecked.defaultof<'info> - let result = agent.PostAndAsyncReply (fun channel -> Read (channel, fun info -> answer <- info)) + + let result = + agent.PostAndAsyncReply (fun channel -> Read (channel, (fun info -> answer <- info))) + async { do! result return answer - } \ No newline at end of file + } diff --git a/SampleApplication/Program.fs b/SampleApplication/Program.fs index 6a1d02c..5bcf5e0 100644 --- a/SampleApplication/Program.fs +++ b/SampleApplication/Program.fs @@ -13,11 +13,9 @@ open Microsoft.Extensions.Logging module Program = let createHostBuilder args = - Host.CreateDefaultBuilder(args) - .ConfigureWebHostDefaults(fun webBuilder -> - webBuilder.UseStartup() - |> ignore - ) + Host + .CreateDefaultBuilder(args) + .ConfigureWebHostDefaults(fun webBuilder -> webBuilder.UseStartup () |> ignore) [] let main args = diff --git a/SampleApplication/Startup.fs b/SampleApplication/Startup.fs index a6e5480..9f5371b 100644 --- a/SampleApplication/Startup.fs +++ b/SampleApplication/Startup.fs @@ -44,108 +44,142 @@ type private ParseOutput = type Startup() = - let client = new WebClient() + let client = new WebClient () - let servers = Array.init 2 (fun _ -> ServerAgent.make (Some { Hour = 0uy ; Minute = 0uy ; Second = 0uy })) + let servers = + Array.init + 2 + (fun _ -> + ServerAgent.make ( + Some + { + Hour = 0uy + Minute = 0uy + Second = 0uy + } + )) /// Convert an input byte to the integer digit it is. /// For example, ord('0') will match to Char(0). let (|Char|_|) (b : byte) : byte option = - if byte '0' <= b && b <= byte '9' then - Some (b - byte '0') - else None + if byte '0' <= b && b <= byte '9' then Some (b - byte '0') else None /// Extremely rough-and-ready function to get a time out of a stream which contains /// text. /// We expect the time to be expressed as hh:mm:ss /// and we do not bother our pretty little heads with Unicode issues. - let parseDateInner (buffer : byte array) (s : Stream) (state : State) : Async = async { - let! written = s.ReadAsync(buffer, 0, 1) |> Async.AwaitTask - if written = 0 then return StreamEnded else + let parseDateInner (buffer : byte array) (s : Stream) (state : State) : Async = + async { + let! written = s.ReadAsync (buffer, 0, 1) |> Async.AwaitTask - match state with - | Waiting -> - match buffer.[0] with - | Char b -> return State (State.ParsedHourFirstDigit b) - | _ -> return State Waiting - | ParsedHourFirstDigit hour -> - match buffer.[0] with - | Char b -> return State (State.ParsedHourAwaitingColon (hour * 10uy + b)) - | _ -> return State Waiting - | ParsedHourAwaitingColon hour -> - match buffer.[0] with - | b when b = byte ':' -> return State (State.ParsedHour hour) - | _ -> return State Waiting - | ParsedHour hour -> - match buffer.[0] with - | Char b -> return State (State.ParsedMinuteFirstDigit (hour, b)) - | _ -> return State Waiting - | ParsedMinuteFirstDigit (hour, min) -> - match buffer.[0] with - | Char b -> return State (State.ParsedMinuteAwaitingColon (hour, 10uy * b + min)) - | _ -> return State Waiting - | ParsedMinuteAwaitingColon (hour, min) -> - match buffer.[0] with - | b when b = byte ':' -> return State (State.ParsedMinute (hour, min)) - | _ -> return State Waiting - | ParsedMinute (hour, min) -> - match buffer.[0] with - | Char b -> return State (State.ParsedSecondFirstDigit (hour, min, b)) - | _ -> return State Waiting - | ParsedSecondFirstDigit (hour, min, sec) -> - match buffer.[0] with - | Char b -> return Complete { Hour = hour ; Minute = min ; Second = 10uy * sec + b } - | _ -> return State Waiting - } + if written = 0 then + return StreamEnded + else - let parseDate (stream : Stream) : Async = async { - let buffer = [| 0uy |] - let rec go (state : State) = async { - match! parseDateInner buffer stream state with - | StreamEnded -> return None - | Complete d -> return Some d - | State state -> - return! go state + match state with + | Waiting -> + match buffer.[0] with + | Char b -> return State (State.ParsedHourFirstDigit b) + | _ -> return State Waiting + | ParsedHourFirstDigit hour -> + match buffer.[0] with + | Char b -> return State (State.ParsedHourAwaitingColon (hour * 10uy + b)) + | _ -> return State Waiting + | ParsedHourAwaitingColon hour -> + match buffer.[0] with + | b when b = byte ':' -> return State (State.ParsedHour hour) + | _ -> return State Waiting + | ParsedHour hour -> + match buffer.[0] with + | Char b -> return State (State.ParsedMinuteFirstDigit (hour, b)) + | _ -> return State Waiting + | ParsedMinuteFirstDigit (hour, min) -> + match buffer.[0] with + | Char b -> return State (State.ParsedMinuteAwaitingColon (hour, 10uy * b + min)) + | _ -> return State Waiting + | ParsedMinuteAwaitingColon (hour, min) -> + match buffer.[0] with + | b when b = byte ':' -> return State (State.ParsedMinute (hour, min)) + | _ -> return State Waiting + | ParsedMinute (hour, min) -> + match buffer.[0] with + | Char b -> return State (State.ParsedSecondFirstDigit (hour, min, b)) + | _ -> return State Waiting + | ParsedSecondFirstDigit (hour, min, sec) -> + match buffer.[0] with + | Char b -> + return + Complete + { + Hour = hour + Minute = min + Second = 10uy * sec + b + } + | _ -> return State Waiting } - return! go State.Waiting - } + let parseDate (stream : Stream) : Async = + async { + let buffer = [| 0uy |] + + let rec go (state : State) = + async { + match! parseDateInner buffer stream state with + | StreamEnded -> return None + | Complete d -> return Some d + | State state -> return! go state + } + + return! go State.Waiting + } let update : Async = async { // Note: there is absolutely no error handling here at all. // Obviously that would be desirable. - let result = client.OpenRead (Uri "insert your URL here") + let result = + client.OpenRead (Uri "https://www.timeanddate.com/worldclock/uk") + return! parseDate result } // Note that we haven't kicked this off yet - it's still an Async - let pulses = ExternalInfoProvider.make Async.Sleep update 500 servers + let pulses = + ExternalInfoProvider.make Async.Sleep update 500 servers // This method gets called by the runtime. Use this method to add services to the container. // For more information on how to configure your application, visit https://go.microsoft.com/fwlink/?LinkID=398940 - member _.ConfigureServices(services: IServiceCollection) = + member _.ConfigureServices (services : IServiceCollection) = pulses |> Async.RunSynchronously |> ignore // This method gets called by the runtime. Use this method to configure the HTTP request pipeline. - member _.Configure(app: IApplicationBuilder, env: IWebHostEnvironment) = - if env.IsDevelopment() then - app.UseDeveloperExceptionPage() |> ignore + member _.Configure (app : IApplicationBuilder, env : IWebHostEnvironment) = + if env.IsDevelopment () then + app.UseDeveloperExceptionPage () |> ignore - app.UseRouting() - .UseEndpoints(fun endpoints -> - endpoints.MapGet("/", fun context -> - async { - let! answer = ServerAgent.giveNextResponse servers.[0] - match answer with - | None -> do! context.Response.WriteAsync("Oh noes") |> Async.AwaitTask - | Some date -> - do! context.Response.WriteAsync(sprintf "%i:%i:%i" date.Hour date.Minute date.Second) |> Async.AwaitTask - return () - } - |> Async.StartAsTask - :> Task + app + .UseRouting() + .UseEndpoints(fun endpoints -> + endpoints.MapGet ( + "/", + fun context -> + async { + let! answer = ServerAgent.giveNextResponse servers.[0] + + match answer with + | None -> + do! + context.Response.WriteAsync ("Oh noes") + |> Async.AwaitTask + | Some date -> + do! + context.Response.WriteAsync (sprintf "%i:%i:%i" date.Hour date.Minute date.Second) + |> Async.AwaitTask + + return () + } + |> Async.StartAsTask + :> Task ) - |> ignore - ) - |> ignore \ No newline at end of file + |> ignore) + |> ignore diff --git a/Test/PropertyBasedTests.fs b/Test/PropertyBasedTests.fs deleted file mode 100644 index 835cb58..0000000 --- a/Test/PropertyBasedTests.fs +++ /dev/null @@ -1,36 +0,0 @@ -namespace PulsingServer.Test - -open PulsingServer -open NUnit.Framework -open FsUnitTyped - -type AgentIndex = AgentIndex of int -type ReadIndex = ReadIndex of int - -type Action<'info> = - | ChangeData of 'info - | BeginRead of AgentIndex - | AwaitRead of ReadIndex - -[] -module TestProperties = - - let executeAction - (ext : ExternalInfoProvider<'info>) - (agents : ServerAgent<'info> array) - ((readNumber : int), (awaitingRead : Map>)) - (action : Action<'info>) - = - match action with - | BeginRead (AgentIndex i) -> - let mutable answer = None - let result = ServerAgent.giveNextResponse (fun resp -> answer <- Some resp) agents.[i] - let output = - async { - do! result - return Option.get answer - } - ext, agents, (readNumber + 1, Map.add (ReadIndex readNumber) output awaitingRead) - | AwaitRead index -> - awaitingRead.[index] - |> Async.RunSynchronously diff --git a/Test/TestServer.fs b/Test/TestServer.fs index 694fde1..1466653 100644 --- a/Test/TestServer.fs +++ b/Test/TestServer.fs @@ -17,14 +17,19 @@ module TestPulsingServer = let mutable info = "original info" let count = ref 0 - let getInfo = async { - System.Threading.Interlocked.Increment count |> ignore - let info = lock info (fun () -> sprintf "%s" info) - return info - } + let getInfo = + async { + System.Threading.Interlocked.Increment count + |> ignore + + let info = lock info (fun () -> sprintf "%s" info) + return info + } + let dontSleep (_ : TimeSpan) = async { return () } - let infoProvider = ExternalInfoProvider.make dontSleep getInfo 10 [| responder1 ; responder2 |] + let infoProvider = + ExternalInfoProvider.make dontSleep getInfo 10 [| responder1 ; responder2 |] // We're not getting new info, because we didn't await the construction of ExternalInfoProvider count.Value |> shouldEqual 0 @@ -32,30 +37,28 @@ module TestPulsingServer = // The two responders are ready, but have not received anything yet. do let response = ServerAgent.giveNextResponse responder1 + response |> Async.RunSynchronously |> shouldEqual "hi" // Now start off the ExternalInfoProvider! - let _ = - infoProvider - |> Async.RunSynchronously + let _ = infoProvider |> Async.RunSynchronously // Now we have definitely started pinging... count.Value |> shouldBeGreaterThan 0 - // ... and at some point soon, the first responder will act on the info it receives. + // The two responders are ready, but have not received anything yet. do let response = ServerAgent.giveNextResponse responder1 + response |> Async.RunSynchronously |> shouldEqual "original info" // Update the info. responder1 is not going to fail on the `received` check, because that // was one-shot. - lock info (fun () -> - info <- "new info!" - ) + lock info (fun () -> info <- "new info!") // Get responder2 ready to act in a couple of different ways. let response2 = ServerAgent.giveNextResponse responder2 @@ -69,6 +72,7 @@ module TestPulsingServer = // By design, we can't distinguish between these two cases. (info = "new info!" || info = "original info") |> shouldEqual true + response2' |> Async.RunSynchronously |> fun info -> @@ -78,16 +82,23 @@ module TestPulsingServer = // Eventually, responder2 does pick up the new info. let rec go () = - let response = ServerAgent.giveNextResponse responder2 |> Async.RunSynchronously - if response <> "new info!" then go () + let response = + ServerAgent.giveNextResponse responder2 + |> Async.RunSynchronously + + if response <> "new info!" then + go () + go () - [] - [] + [] + [] let ``Stress test`` (n : int, queues : int) = - let responders = Array.init queues (fun _ -> ServerAgent.make "uninitialised") + let responders = + Array.init queues (fun _ -> ServerAgent.make "uninitialised") let mutable data = "" + let getInfo = async { // Simulate a slow network call @@ -95,6 +106,7 @@ module TestPulsingServer = let result = lock data (fun () -> sprintf "%s" data) return result } + let _infoProvider = ExternalInfoProvider.make Async.Sleep getInfo 10 responders |> Async.RunSynchronously @@ -107,13 +119,17 @@ module TestPulsingServer = // n requests come in - note that we don't start them off yet, // because we want to time them separately let requests = - Array.init n (fun i -> - async { - let! answer = ServerAgent.giveNextResponse responders.[i % queues] - if answer <> "" then failwith "unexpected response!" - return () - } - ) + Array.init + n + (fun i -> + async { + let! answer = ServerAgent.giveNextResponse responders.[i % queues] + + if answer <> "" then + failwith "unexpected response!" + + return () + }) |> Async.Parallel |> Async.Ignore @@ -122,8 +138,7 @@ module TestPulsingServer = time.Restart () - requests - |> Async.RunSynchronously + requests |> Async.RunSynchronously time.Stop () printfn "Time to execute: %i ms" time.ElapsedMilliseconds @@ -131,42 +146,47 @@ module TestPulsingServer = // Now prepare n more requests, but halfway through, we'll be changing the data. // Again, don't kick them off right now; wait for the timer. time.Restart () + let requests = - Array.init n (fun i -> - if i = n / 2 then - async { - lock data (fun () -> data <- "new data") - return None - } - else - async { - do! Async.Sleep (TimeSpan.FromMilliseconds (float i)) - let! response = ServerAgent.giveNextResponse (responders.[i % queues]) - return Some response - } - ) + Array.init + n + (fun i -> + if i = n / 2 then + async { + lock data (fun () -> data <- "new data") + return None + } + else + async { + do! Async.Sleep (TimeSpan.FromMilliseconds (float i)) + let! response = ServerAgent.giveNextResponse (responders.[i % queues]) + return Some response + }) |> Async.Parallel + time.Stop () printfn "Time to construct requests: %i ms" time.ElapsedMilliseconds time.Restart () - let results = - requests - |> Async.RunSynchronously + let results = requests |> Async.RunSynchronously time.Stop () printfn "Time to execute: %i ms" time.ElapsedMilliseconds let grouped = - results - |> Array.countBy id - |> Map.ofArray + results |> Array.countBy id |> Map.ofArray grouped.[None] |> shouldEqual 1 - let pre = Map.tryFind (Some "") grouped |> Option.defaultValue 0 - let post = Map.tryFind (Some "new data") grouped |> Option.defaultValue 0 + + let pre = + Map.tryFind (Some "") grouped + |> Option.defaultValue 0 + + let post = + Map.tryFind (Some "new data") grouped + |> Option.defaultValue 0 pre + post |> shouldEqual (n - 1) - printfn "Got old data: %i. Got new data: %i." pre post \ No newline at end of file + printfn "Got old data: %i. Got new data: %i." pre post diff --git a/test.fsx b/test.fsx index dae8b33..52d3458 100644 --- a/test.fsx +++ b/test.fsx @@ -1,17 +1,15 @@ open System.Net open System.Diagnostics -use timer = new Stopwatch() +let timer = new Stopwatch() timer.Restart() -[ - for i in 1..1000 do - yield - async { - let w = new WebClient() - return w.DownloadString("http://localhost:5000/") - } -] +[ for i in 1 .. 1000 do + yield + async { + let w = new WebClient() + return w.DownloadString("http://localhost:5000/") + } ] |> Async.Parallel |> Async.RunSynchronously