Add support for parallel file download

Author: vlukash

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"

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
+    }

src/app/Fake.Net.Http/Fake.Net.Http.fsproj

@@ -15,8 +15,9 @@
   </PropertyGroup>
   <ItemGroup>
     <Compile Include="AssemblyInfo.fs" />
-    <Compile Include="ResultBuilder.fs" />
-    <Compile Include="FilePath.fs" />
+    <Compile Include="Async.fs" />
+    <Compile Include="Result.fs" />
+    <Compile Include="List.fs" />
     <Compile Include="HttpLoader.fs" />
   </ItemGroup>
   <ItemGroup>

src/app/Fake.Net.Http/FilePath.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<FilePath, Err list>  = 
+        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<Uri, Err list> = 
         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<FilePath, string list>) =
+    /// [omit]
+    let private createDownloadInfo (input: DownloadParameters): Result<DownloadInfo, Err list> = 
+        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<Result<FilePath,string list>>  = 
+    /// [omit]
+    let private saveStreamToFileAsync (filePath: FilePath) (stream: Stream) : Async<Result<FilePath, Err list>> =
         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<Result<FilePath,string list>>  = 
+    /// [omit]
+    let private downloadStreamToFileAsync (info: DownloadInfo) : Async<Result<FilePath, Err list>>  =
         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<Result<FilePath, Err list>> =
+        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<FilePath,string list>
-    let downloadFile (filePathStr: string) (url: string) : Result<FilePath,string list> =
+    /// ## 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<string, string list> =
+        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<FilePath, Err list>
+    /// ## 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<string list, string list> =
+        input
+        // DownloadParameters -> "Async<Result<FilePath, Err list>> list"
+        |> List.map downloadFileAsync
+        // "Async<Result<FilePath, Err list>> list" -> "Async<Result<FilePath, Err list> list>"
+        |> List.sequenceAsyncA
+        // "Async<Result<FilePath, Err list> list>" -> "Async<Result<FilePath list, Err list>>"
+        |> Async.map List.sequenceResultA
+        |> Async.RunSynchronously
+        |> printDownloadResults

src/app/Fake.Net.Http/HttpLoader.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<Async>" into a "Async<list>" 
+    /// 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<Result>" into a "Result<list>" 
+    /// and collect the results using apply.
+    let sequenceResultA x = traverseResultA id x
+

src/app/Fake.Net.Http/List.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])