From ad4741e8191fb83ff49f6adfc3b6d37d5f3046b7 Mon Sep 17 00:00:00 2001 From: Volodymyr Lukashevych Date: Sun, 10 Dec 2017 12:03:06 -0800 Subject: [PATCH 1/3] Add HTTP module for downloading files --- src/app/Fake.Net.HTTP/AssemblyInfo.fs | 17 ++++++ src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj | 26 ++++++++ src/app/Fake.Net.HTTP/FilePath.fs | 17 ++++++ src/app/Fake.Net.HTTP/HttpLoader.fs | 71 ++++++++++++++++++++++ src/app/Fake.Net.HTTP/ResultBuilder.fs | 11 ++++ src/app/Fake.Net.HTTP/paket.references | 5 ++ 6 files changed, 147 insertions(+) create mode 100644 src/app/Fake.Net.HTTP/AssemblyInfo.fs create mode 100644 src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj create mode 100644 src/app/Fake.Net.HTTP/FilePath.fs create mode 100644 src/app/Fake.Net.HTTP/HttpLoader.fs create mode 100644 src/app/Fake.Net.HTTP/ResultBuilder.fs create mode 100644 src/app/Fake.Net.HTTP/paket.references diff --git a/src/app/Fake.Net.HTTP/AssemblyInfo.fs b/src/app/Fake.Net.HTTP/AssemblyInfo.fs new file mode 100644 index 00000000000..ec7a838dcfa --- /dev/null +++ b/src/app/Fake.Net.HTTP/AssemblyInfo.fs @@ -0,0 +1,17 @@ +// Auto-Generated by FAKE; do not edit +namespace System +open System.Reflection + +[] +[] +[] +[] +[] +do () + +module internal AssemblyVersionInformation = + let [] AssemblyTitle = "FAKE - F# Make HTTP downloader" + let [] AssemblyProduct = "FAKE - F# Make" + let [] AssemblyVersion = "5.0.0" + let [] AssemblyInformationalVersion = "5.0.0" + let [] AssemblyFileVersion = "5.0.0" diff --git a/src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj b/src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj new file mode 100644 index 00000000000..f9e4814b9a1 --- /dev/null +++ b/src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj @@ -0,0 +1,26 @@ + + + 1.0.0-alpha-10 + net46;netstandard1.6;netstandard2.0 + pdbonly + true + Fake.Net.Http + Library + + + $(DefineConstants);NETSTANDARD;USE_HTTPCLIENT + + + $(DefineConstants);RELEASE + + + + + + + + + + + + diff --git a/src/app/Fake.Net.HTTP/FilePath.fs b/src/app/Fake.Net.HTTP/FilePath.fs new file mode 100644 index 00000000000..82b63d8d4e8 --- /dev/null +++ b/src/app/Fake.Net.HTTP/FilePath.fs @@ -0,0 +1,17 @@ +namespace Fake.Net + +open System.IO + +module FilePath = + type FilePath = FilePath of string + + let create (filePath:string) = + try + let fullPath = FilePath (Path.GetFullPath(filePath)) + Ok (fullPath) + with + | ex -> + let err = sprintf "[%s] %A" filePath ex.Message + Error [err ] + + let value (FilePath e) = e \ No newline at end of file diff --git a/src/app/Fake.Net.HTTP/HttpLoader.fs b/src/app/Fake.Net.HTTP/HttpLoader.fs new file mode 100644 index 00000000000..b2ebf9ac56a --- /dev/null +++ b/src/app/Fake.Net.HTTP/HttpLoader.fs @@ -0,0 +1,71 @@ +namespace Fake.Net + +open System +open System.IO +open System.Net.Http + +open Fake.Core + +open FilePath +open ResultBuilder + +/// Contains +module Http = + + let result = ResultBuilder() + + let createUri (uriStr: string) = + try + Ok (Uri uriStr) + with + | ex -> + let err = sprintf "[%s] %A" uriStr ex.Message + Error [err ] + + let showDownloadResult (result: Result) = + match result with + | Ok (FilePath(filePath)) -> + Trace.log <| sprintf "Downloaded : [%s]" filePath + | Error errs -> + Trace.traceError <| sprintf "Failed: %A" errs + + let saveStreamToFile (filePath: FilePath) (stream: Stream) : Async> = + async { + let filePathStr = FilePath.value filePath + try + use fileStream = new FileStream(filePathStr, FileMode.Create, FileAccess.Write, FileShare.None) + do! stream.CopyToAsync(fileStream) |> Async.AwaitTask + return (Ok filePath) + with + | ex -> + let err = sprintf "[%s] %A" filePathStr ex.Message + return Error [err ] + } + + let downloadToFileStream (filePath: FilePath) (uri:Uri) : Async> = + async { + use client = new HttpClient() + try + // do not buffer the response + let! response = client.GetAsync(uri, HttpCompletionOption.ResponseHeadersRead) |> Async.AwaitTask + response.EnsureSuccessStatusCode () |> ignore + use! stream = response.Content.ReadAsStreamAsync() |> Async.AwaitTask + return! saveStreamToFile filePath stream + with + | ex -> + let err = sprintf "[%s] %A" uri.Host ex.Message + return Error [err ] + } + + /// Download file by the given file path and Url + /// string -> string -> Result + let downloadFile (filePathStr: string) (url: string) : Result = + + let downloadResult = result { + let! filePath = FilePath.create filePathStr + let! uri = createUri url + let! result = downloadToFileStream filePath uri |> Async.RunSynchronously + return result + } + do showDownloadResult downloadResult + downloadResult diff --git a/src/app/Fake.Net.HTTP/ResultBuilder.fs b/src/app/Fake.Net.HTTP/ResultBuilder.fs new file mode 100644 index 00000000000..108a9729c14 --- /dev/null +++ b/src/app/Fake.Net.HTTP/ResultBuilder.fs @@ -0,0 +1,11 @@ +namespace Fake.Net + +module ResultBuilder = + type ResultBuilder() = + member __.Bind(m, f) = + match m with + | Error e -> Error e + | Ok a -> f a + + member __.Return(x) = + Ok x \ No newline at end of file diff --git a/src/app/Fake.Net.HTTP/paket.references b/src/app/Fake.Net.HTTP/paket.references new file mode 100644 index 00000000000..308ff6d561f --- /dev/null +++ b/src/app/Fake.Net.HTTP/paket.references @@ -0,0 +1,5 @@ +group netcore + +FSharp.Core +NETStandard.Library +System.Net.Http \ No newline at end of file From 1a8ba9ba009d94156a27982798ce9571ee113deb Mon Sep 17 00:00:00 2001 From: Volodymyr Lukashevych Date: Tue, 12 Dec 2017 17:40:23 -0800 Subject: [PATCH 2/3] Update Fake-netcore.sln --- build.fsx | 1 + src/Fake-netcore.sln | 15 +++++++++++++++ .../AssemblyInfo.fs | 8 ++++---- .../Fake.Net.Http.fsproj | 0 .../{Fake.Net.HTTP => Fake.Net.Http}/FilePath.fs | 0 .../HttpLoader.fs | 0 .../ResultBuilder.fs | 0 .../paket.references | 0 8 files changed, 20 insertions(+), 4 deletions(-) rename src/app/{Fake.Net.HTTP => Fake.Net.Http}/AssemblyInfo.fs (62%) rename src/app/{Fake.Net.HTTP => Fake.Net.Http}/Fake.Net.Http.fsproj (100%) rename src/app/{Fake.Net.HTTP => Fake.Net.Http}/FilePath.fs (100%) rename src/app/{Fake.Net.HTTP => Fake.Net.Http}/HttpLoader.fs (100%) rename src/app/{Fake.Net.HTTP => Fake.Net.Http}/ResultBuilder.fs (100%) rename src/app/{Fake.Net.HTTP => Fake.Net.Http}/paket.references (100%) diff --git a/build.fsx b/build.fsx index b4b08231b2b..77233fc98cb 100644 --- a/build.fsx +++ b/build.fsx @@ -207,6 +207,7 @@ let dotnetAssemblyInfos = "Fake.DotNet.Xamarin", "Running Xamarin builds" "Fake.IO.FileSystem", "Core Filesystem utilities" "Fake.IO.Zip", "Core Zip functionality" + "Fake.Net.Http", "HTTP Client" "Fake.netcore", "Command line tool" "Fake.Runtime", "Core runtime features" "Fake.Tools.Git", "Running git commands" diff --git a/src/Fake-netcore.sln b/src/Fake-netcore.sln index 240e8ec6c45..90cd5e4798b 100644 --- a/src/Fake-netcore.sln +++ b/src/Fake-netcore.sln @@ -73,6 +73,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fake.Api.GitHub", "app\Fake EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fake.DotNet.Xamarin", "app\Fake.DotNet.Xamarin\Fake.DotNet.Xamarin.fsproj", "{13C1F95D-2FAD-4890-BF94-0AE7CF9AB2FC}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fake.Net.Http", "app\Fake.Net.Http\Fake.Net.Http.fsproj", "{D24CEE35-B6C0-4C92-AE18-E80F90B69974}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -494,6 +496,18 @@ Global {13C1F95D-2FAD-4890-BF94-0AE7CF9AB2FC}.Release|x64.Build.0 = Release|x64 {13C1F95D-2FAD-4890-BF94-0AE7CF9AB2FC}.Release|x86.ActiveCfg = Release|x86 {13C1F95D-2FAD-4890-BF94-0AE7CF9AB2FC}.Release|x86.Build.0 = Release|x86 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Debug|Any CPU.Build.0 = Debug|Any CPU + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Debug|x64.ActiveCfg = Debug|x64 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Debug|x64.Build.0 = Debug|x64 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Debug|x86.ActiveCfg = Debug|x86 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Debug|x86.Build.0 = Debug|x86 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Release|Any CPU.ActiveCfg = Release|Any CPU + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Release|Any CPU.Build.0 = Release|Any CPU + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Release|x64.ActiveCfg = Release|x64 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Release|x64.Build.0 = Release|x64 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Release|x86.ActiveCfg = Release|x86 + {D24CEE35-B6C0-4C92-AE18-E80F90B69974}.Release|x86.Build.0 = Release|x86 EndGlobalSection GlobalSection(NestedProjects) = preSolution {E2CF8635-E7C4-4470-92DD-F706F052BF7B} = {7BFFAE76-DEE9-417A-A79B-6A6644C4553A} @@ -529,5 +543,6 @@ Global {58A3EDF0-CA9D-4757-B1E8-2A4E3592B308} = {7BFFAE76-DEE9-417A-A79B-6A6644C4553A} {4BCE4F9C-8FC2-4207-81F1-20CB07D852DC} = {7BFFAE76-DEE9-417A-A79B-6A6644C4553A} {13C1F95D-2FAD-4890-BF94-0AE7CF9AB2FC} = {7BFFAE76-DEE9-417A-A79B-6A6644C4553A} + {D24CEE35-B6C0-4C92-AE18-E80F90B69974} = {7BFFAE76-DEE9-417A-A79B-6A6644C4553A} EndGlobalSection EndGlobal diff --git a/src/app/Fake.Net.HTTP/AssemblyInfo.fs b/src/app/Fake.Net.Http/AssemblyInfo.fs similarity index 62% rename from src/app/Fake.Net.HTTP/AssemblyInfo.fs rename to src/app/Fake.Net.Http/AssemblyInfo.fs index ec7a838dcfa..98f03b42c0a 100644 --- a/src/app/Fake.Net.HTTP/AssemblyInfo.fs +++ b/src/app/Fake.Net.Http/AssemblyInfo.fs @@ -2,16 +2,16 @@ namespace System open System.Reflection -[] +[] [] [] -[] +[] [] do () module internal AssemblyVersionInformation = - let [] AssemblyTitle = "FAKE - F# Make HTTP downloader" + let [] AssemblyTitle = "FAKE - F# Make HTTP Client" let [] AssemblyProduct = "FAKE - F# Make" let [] AssemblyVersion = "5.0.0" - let [] AssemblyInformationalVersion = "5.0.0" + let [] AssemblyInformationalVersion = "5.0.0-beta010" let [] AssemblyFileVersion = "5.0.0" diff --git a/src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj b/src/app/Fake.Net.Http/Fake.Net.Http.fsproj similarity index 100% rename from src/app/Fake.Net.HTTP/Fake.Net.Http.fsproj rename to src/app/Fake.Net.Http/Fake.Net.Http.fsproj diff --git a/src/app/Fake.Net.HTTP/FilePath.fs b/src/app/Fake.Net.Http/FilePath.fs similarity index 100% rename from src/app/Fake.Net.HTTP/FilePath.fs rename to src/app/Fake.Net.Http/FilePath.fs diff --git a/src/app/Fake.Net.HTTP/HttpLoader.fs b/src/app/Fake.Net.Http/HttpLoader.fs similarity index 100% rename from src/app/Fake.Net.HTTP/HttpLoader.fs rename to src/app/Fake.Net.Http/HttpLoader.fs diff --git a/src/app/Fake.Net.HTTP/ResultBuilder.fs b/src/app/Fake.Net.Http/ResultBuilder.fs similarity index 100% rename from src/app/Fake.Net.HTTP/ResultBuilder.fs rename to src/app/Fake.Net.Http/ResultBuilder.fs diff --git a/src/app/Fake.Net.HTTP/paket.references b/src/app/Fake.Net.Http/paket.references similarity index 100% rename from src/app/Fake.Net.HTTP/paket.references rename to src/app/Fake.Net.Http/paket.references From cb2fb5eea33b5e2b176039f9566a16e2d33b2a2b Mon Sep 17 00:00:00 2001 From: Volodymyr Lukashevych Date: Mon, 18 Dec 2017 23:20:43 -0800 Subject: [PATCH 3/3] Add support for parallel file download --- build.fsx | 1 + src/app/Fake.Net.Http/Async.fs | 26 +++++ src/app/Fake.Net.Http/Fake.Net.Http.fsproj | 5 +- src/app/Fake.Net.Http/FilePath.fs | 17 --- src/app/Fake.Net.Http/HttpLoader.fs | 129 ++++++++++++++++----- src/app/Fake.Net.Http/List.fs | 56 +++++++++ src/app/Fake.Net.Http/Result.fs | 24 ++++ src/app/Fake.Net.Http/ResultBuilder.fs | 11 -- 8 files changed, 208 insertions(+), 61 deletions(-) create mode 100644 src/app/Fake.Net.Http/Async.fs delete mode 100644 src/app/Fake.Net.Http/FilePath.fs create mode 100644 src/app/Fake.Net.Http/List.fs create mode 100644 src/app/Fake.Net.Http/Result.fs delete mode 100644 src/app/Fake.Net.Http/ResultBuilder.fs diff --git a/build.fsx b/build.fsx index 77233fc98cb..833b4502981 100644 --- a/build.fsx +++ b/build.fsx @@ -626,6 +626,7 @@ let netCoreProjs = ++ "src/app/Fake.Windows.*/*.fsproj" ++ "src/app/Fake.IO.*/*.fsproj" ++ "src/app/Fake.Tools.*/*.fsproj" + ++ "src/app/Fake.Net.*/*.fsproj" ++ "src/app/Fake.netcore/*.fsproj" ++ "src/app/Fake.Testing.*/*.fsproj" ++ "src/app/Fake.Runtime/*.fsproj" diff --git a/src/app/Fake.Net.Http/Async.fs b/src/app/Fake.Net.Http/Async.fs new file mode 100644 index 00000000000..332a0f20c7e --- /dev/null +++ b/src/app/Fake.Net.Http/Async.fs @@ -0,0 +1,26 @@ +namespace Fake.Net.Async + +module Async = + let result = async.Return + let map f value = async { + let! v = value + return f v + } + + let bind f xAsync = async { + let! x = xAsync + return! f x + } + + let apply fAsync xAsync = async { + // start the two asyncs in parallel + let! fChild = Async.StartChild fAsync + let! xChild = Async.StartChild xAsync + + // wait for the results + let! f = fChild + let! x = xChild + + // apply the function to the results + return f x + } \ No newline at end of file diff --git a/src/app/Fake.Net.Http/Fake.Net.Http.fsproj b/src/app/Fake.Net.Http/Fake.Net.Http.fsproj index f9e4814b9a1..65bd5e493cd 100644 --- a/src/app/Fake.Net.Http/Fake.Net.Http.fsproj +++ b/src/app/Fake.Net.Http/Fake.Net.Http.fsproj @@ -15,8 +15,9 @@ - - + + + diff --git a/src/app/Fake.Net.Http/FilePath.fs b/src/app/Fake.Net.Http/FilePath.fs deleted file mode 100644 index 82b63d8d4e8..00000000000 --- a/src/app/Fake.Net.Http/FilePath.fs +++ /dev/null @@ -1,17 +0,0 @@ -namespace Fake.Net - -open System.IO - -module FilePath = - type FilePath = FilePath of string - - let create (filePath:string) = - try - let fullPath = FilePath (Path.GetFullPath(filePath)) - Ok (fullPath) - with - | ex -> - let err = sprintf "[%s] %A" filePath ex.Message - Error [err ] - - let value (FilePath e) = e \ No newline at end of file diff --git a/src/app/Fake.Net.Http/HttpLoader.fs b/src/app/Fake.Net.Http/HttpLoader.fs index b2ebf9ac56a..d801ea5876f 100644 --- a/src/app/Fake.Net.Http/HttpLoader.fs +++ b/src/app/Fake.Net.Http/HttpLoader.fs @@ -6,66 +6,133 @@ open System.Net.Http open Fake.Core -open FilePath -open ResultBuilder +open Fake.Net.Async +open Fake.Net.Result +open Fake.Net.List -/// Contains +/// HTTP Client for downloading files module Http = - let result = ResultBuilder() + /// Input parameter type + type DownloadParameters = { + Uri: string + Path: string + } - let createUri (uriStr: string) = + /// Type aliases for local file path and error messages + type private FilePath = string + type private Err = string + + /// Contains validated Uri and FilePath info for further download + type private DownloadInfo = { + Uri: Uri + LocalFilePath: FilePath + } + + /// [omit] + let private createFilePath (filePathStr: string): Result = + try + let fullPath = Path.GetFullPath(filePathStr) + Ok (fullPath) + with + | ex -> + let err = sprintf "[%s] %s" filePathStr ex.Message + Error [err ] + + /// [omit] + let private createUri (uriStr: string): Result = try Ok (Uri uriStr) with | ex -> - let err = sprintf "[%s] %A" uriStr ex.Message + let err = sprintf "[%s] %s" uriStr ex.Message Error [err ] - let showDownloadResult (result: Result) = + /// [omit] + let private createDownloadInfo (input: DownloadParameters): Result = + let () = Result.map + let (<*>) = Result.apply + + let createDownloadInfoRecord (filePath: FilePath) (uri:Uri) = + { Uri=uri; LocalFilePath=filePath } + + let filePathResult = createFilePath input.Path + let urlResult = createUri input.Uri + createDownloadInfoRecord filePathResult <*> urlResult + + /// [omit] + let private printDownloadResults result = match result with - | Ok (FilePath(filePath)) -> - Trace.log <| sprintf "Downloaded : [%s]" filePath - | Error errs -> - Trace.traceError <| sprintf "Failed: %A" errs + | Ok result -> + Trace.log <| sprintf "Downloaded : [%A]" result + | Error errs -> + Trace.traceError <| sprintf "Failed: %A" errs + result - let saveStreamToFile (filePath: FilePath) (stream: Stream) : Async> = + /// [omit] + let private saveStreamToFileAsync (filePath: FilePath) (stream: Stream) : Async> = async { - let filePathStr = FilePath.value filePath try - use fileStream = new FileStream(filePathStr, FileMode.Create, FileAccess.Write, FileShare.None) + use fileStream = new FileStream(filePath, FileMode.Create, FileAccess.Write, FileShare.None) do! stream.CopyToAsync(fileStream) |> Async.AwaitTask return (Ok filePath) with | ex -> - let err = sprintf "[%s] %A" filePathStr ex.Message + let err = sprintf "[%s] %s" filePath ex.Message return Error [err ] } - let downloadToFileStream (filePath: FilePath) (uri:Uri) : Async> = + /// [omit] + let private downloadStreamToFileAsync (info: DownloadInfo) : Async> = async { use client = new HttpClient() try + Trace.log <| sprintf "Downloading [%s] ..." info.Uri.OriginalString // do not buffer the response - let! response = client.GetAsync(uri, HttpCompletionOption.ResponseHeadersRead) |> Async.AwaitTask + let! response = client.GetAsync(info.Uri, HttpCompletionOption.ResponseHeadersRead) |> Async.AwaitTask response.EnsureSuccessStatusCode () |> ignore - use! stream = response.Content.ReadAsStreamAsync() |> Async.AwaitTask - return! saveStreamToFile filePath stream + use! stream = response.Content.ReadAsStreamAsync() |> Async.AwaitTask + return! saveStreamToFileAsync info.LocalFilePath stream with - | ex -> - let err = sprintf "[%s] %A" uri.Host ex.Message + | ex -> + let err = sprintf "[%s] %s" info.Uri.Host ex.Message return Error [err ] } - /// Download file by the given file path and Url + /// [omit] + let private downloadFileAsync (input: DownloadParameters): Async> = + let valImp = createDownloadInfo input + match valImp with + | Ok x -> + downloadStreamToFileAsync x + | Error errs -> + Async.result (Error errs) + + /// Download file by the given file path and Uri /// string -> string -> Result - let downloadFile (filePathStr: string) (url: string) : Result = + /// ## Parameters + /// - `localFilePath` - A local file path to download file + /// - `uri` - A Uri to download from + /// ## Returns + /// - `Result` type. Success branch contains a downloaded file path. Failure branch contains a list of errors + let downloadFile (localFilePath: string) (uri: string) : Result = + downloadFileAsync { Uri=uri; Path=localFilePath } + |> Async.RunSynchronously + |> printDownloadResults - let downloadResult = result { - let! filePath = FilePath.create filePathStr - let! uri = createUri url - let! result = downloadToFileStream filePath uri |> Async.RunSynchronously - return result - } - do showDownloadResult downloadResult - downloadResult + /// Download list of Uri's in parallel + /// DownloadParameters -> Result + /// ## Parameters + /// - `input` - List of Http.DownloadParameters. Each Http.DownloadParameters record type contains Uri and file path + /// ## Returns + /// - `Result` type. Success branch contains a list of downloaded file paths. Failure branch contains a list of errors + let downloadFiles (input: DownloadParameters list) : Result = + input + // DownloadParameters -> "Async> list" + |> List.map downloadFileAsync + // "Async> list" -> "Async list>" + |> List.sequenceAsyncA + // "Async list>" -> "Async>" + |> Async.map List.sequenceResultA + |> Async.RunSynchronously + |> printDownloadResults \ No newline at end of file diff --git a/src/app/Fake.Net.Http/List.fs b/src/app/Fake.Net.Http/List.fs new file mode 100644 index 00000000000..b2b2c5d247e --- /dev/null +++ b/src/app/Fake.Net.Http/List.fs @@ -0,0 +1,56 @@ +namespace Fake.Net.List + +open Fake.Net.Async +open Fake.Net.Result + +// List extensions for traversing Result and Async types +// Functions from fsharpforfunandprofit.com, please see details here: +// https://fsharpforfunandprofit.com/posts/elevated-world-5/ +module List = + + /// Map a Async producing function over a list to get a new Async + /// using applicative style + /// ('a -> Async<'b>) -> 'a list -> Async<'b list> + let rec traverseAsyncA f list = + + // define the applicative functions + let (<*>) = Async.apply + let retn = Async.result + + // define a "cons" function + let cons head tail = head :: tail + + // right fold over the list + let initState = retn [] + let folder head tail = + retn cons <*> (f head) <*> tail + + List.foldBack folder list initState + + /// Transform a "list" into a "Async" + /// and collect the results using apply. + let sequenceAsyncA x = traverseAsyncA id x + + /// Map a Result producing function over a list to get a new Result + /// using applicative style + /// ('a -> Result<'b>) -> 'a list -> Result<'b list> + let rec traverseResultA f list = + + // define the applicative functions + let (<*>) = Result.apply + let retn = Ok + + // define a "cons" function + let cons head tail = head :: tail + + // right fold over the list + let initState = retn [] + let folder head tail = + retn cons <*> (f head) <*> tail + + List.foldBack folder list initState + + /// Transform a "list" into a "Result" + /// and collect the results using apply. + let sequenceResultA x = traverseResultA id x + diff --git a/src/app/Fake.Net.Http/Result.fs b/src/app/Fake.Net.Http/Result.fs new file mode 100644 index 00000000000..ebf3a433960 --- /dev/null +++ b/src/app/Fake.Net.Http/Result.fs @@ -0,0 +1,24 @@ +namespace Fake.Net.Result + +module Result = + + type ResultBuilder() = + member __.Bind(m, f) = + match m with + | Error e -> Error e + | Ok a -> f a + + member __.Return(x) = + Ok x + + let apply fResult xResult = + match fResult,xResult with + | Ok f, Ok x -> + Ok (f x) + | Error errs, Ok x -> + Error errs + | Ok f, Error errs -> + Error errs + | Error errs1, Error errs2 -> + // concat both lists of errors + Error (List.concat [errs1; errs2]) diff --git a/src/app/Fake.Net.Http/ResultBuilder.fs b/src/app/Fake.Net.Http/ResultBuilder.fs deleted file mode 100644 index 108a9729c14..00000000000 --- a/src/app/Fake.Net.Http/ResultBuilder.fs +++ /dev/null @@ -1,11 +0,0 @@ -namespace Fake.Net - -module ResultBuilder = - type ResultBuilder() = - member __.Bind(m, f) = - match m with - | Error e -> Error e - | Ok a -> f a - - member __.Return(x) = - Ok x \ No newline at end of file