TaskBuilder: support awaiting non-generic Task and add CE helpers

DataParser.Console/DataFileParseResult.fs

@@ -3,5 +3,6 @@
 open DataParser.Console.DataFiles
 
 type DataFileParseResult =
-    { DataFileName : DataFileName
+    { DataFilePath : FilePath
+      DataFileName : DataFileName
       JsonElements : seq<JsonObject> }

DataParser.Console/DataParser.Console.fsproj

@@ -9,6 +9,7 @@
     <ItemGroup>
         <Compile Include="TaskBuilder.fs" />
         <Compile Include="Task.fs" />
+        <Compile Include="Map.fs" />
         <Compile Include="Result.fs" />
         <Compile Include="ResultBuilder.fs" />
         <Compile Include="ResultMap.fs" />

DataParser.Console/FileRead.fs

@@ -30,7 +30,10 @@ let parseDataFile dataFile =
         return result {
             let! parsedJsonObjects =
                 Result.traverseSeq (parseDataFileLine dataFile.FormatLines) dataFileLines
-            return { DataFileName = dataFile.Name; JsonElements = parsedJsonObjects }
+            return { 
+                DataFilePath = dataFile.FilePath
+                DataFileName = dataFile.Name
+                JsonElements = parsedJsonObjects }
         }
     }
 

DataParser.Console/Map.fs

@@ -0,0 +1,9 @@
+module Map
+
+open System.Threading.Tasks
+
+let traverseTask (f: 'b -> Task<'c>) =
+    Map.fold (fun acc k v -> task { 
+        let! t = f v 
+        and! acc' = acc  
+        return Map.add k t acc' }) (task { return Map.empty })

DataParser.Console/Program.fs

@@ -17,22 +17,44 @@ let okHandler _ = writeOutputFile OutputFolderPath
 let errorHandler filePath errors =
     eprintfn $"Error occurred during processing data file: {filePath}. Errors are : %+A{errors}"
 
+let consolidateResults (ResultMap dataFileFormats) =
+    let folder acc k v =
+        match v with
+        | Ok dataFileFormat ->
+            task {
+                let! parseResult = parseDataFile dataFileFormat
+                match parseResult with
+                | Ok result ->
+                    return! Task.liftA3 Map.add (Task.singleton k) (Task.singleton (Ok result)) acc
+                | Error e ->
+                    return! Task.liftA3 Map.add (Task.singleton k) (Task.singleton (Error e)) acc
+            }
+        | Error e -> 
+            task {
+                return! Task.liftA3 Map.add (Task.singleton k) (Task.singleton (Error e)) acc
+            }
+
+    Map.fold folder (Task.singleton Map.empty) dataFileFormats
+    |> Task.map ResultMap
+
 printfn "Reading spec files..."
 
-task {
-    let! specs = readAllSpecFiles SpecFolderPath
+let t =
+    task {
+        let! specs = readAllSpecFiles SpecFolderPath
+
+        let dataFileInfos = getDataFileInfos DataFolderPath
+
+        printfn "Parsing data files..."
+        let dataFileFormats = getDataFileFormats specs dataFileInfos
 
-    let dataFileInfos = getDataFileInfos DataFolderPath
+        let! consolidatedResults = consolidateResults dataFileFormats
 
-    printfn "Parsing data files..."
-    let parsedDateFileFormats = getDataFileFormats specs dataFileInfos
-
-    let dataFileParsedResults =
-        ResultMap.bindResult parseDataFile parsedDateFileFormats
+        printfn "Writing to output folder..."
+        ResultMap.biIter okHandler errorHandler consolidatedResults
 
-    printfn "Writing to output folder..."
-    ResultMap.biIter okHandler errorHandler dataFileParsedResults
+        printfn "Processing complete. Press Enter to exit."
+        ignore <| Console.ReadLine()
+    }
 
-    printfn "Processing complete. Press Enter to exit."
-    ignore <| Console.ReadLine()
-} |> ignore
+t.GetAwaiter().GetResult()

DataParser.Console/ResultMap.fs

@@ -9,12 +9,29 @@ type ResultMap<'TKey, 'TOkValue, 'TErrorValue when 'TKey : comparison> =
 
 module ResultMap =
 
+    let empty = ResultMap Map.empty
+
     let unResultMap (ResultMap m) = m
 
     let map f =
         ResultMap
         << Map.map (fun _ -> Result.map f)
         << unResultMap
+
+    let traverseTask f (ResultMap m) = 
+        let folder acc k v = task {
+            let! acc' = acc
+            match v with
+            | Ok x -> 
+                let! t = f x
+                return Map.add k (Ok t) acc'
+            | Error e -> 
+                return Map.add k (Error e) acc'
+
+        }
+
+        Map.fold folder (task { return Map.empty }) m
+        |> Task.map ResultMap
 
     let bindResult f =
         ResultMap

DataParser.Console/Task.fs

@@ -8,16 +8,24 @@ let map f x = task {
     return f result
 }
 
+let bind f x = task {
+    let! result = x
+    return! f result
+}
+
+let toUnit (x: Task) = task {
+    do! x
+    return ()
+}
+
 let (<!>) = map
 
 let (<*>) (f: Task<'a -> 'b>) (x: Task<'a>) = task {
-    let! _ = Task.WhenAll(f, x) :?> Task<unit>
+    let tasks = [|f :> Task; x :> Task|]
+    let! _ = Task.WhenAll(tasks)
     return f.Result x.Result
 }
 
-let liftA2 f x y = f <!> x <*> y
+let liftA3 f x y z = f <!> x <*> y <*> z
 
-let traverseSeq f xs = 
-    let cons x xs = x :: xs
-    let (<%>) = liftA2 cons
-    Seq.fold (fun acc x -> f x <%> acc) (task { return [] }) xs
+let singleton x = task { return x }

DataParser.Console/TaskBuilder.fs

@@ -4,8 +4,8 @@ module TaskBuilder
 open System.Threading.Tasks
 
 type TaskBuilder() =
-    member _.MergeSources (x, y) = task {
-        let! _ = Task.WhenAll(x, y)
+    member _.MergeSources (x: Task<'a>, y: Task<'b>) = task {
+        let! _ = Task.WhenAll(x :> Task, y :> Task)
         return x.Result, y.Result
     }
 
@@ -14,9 +14,28 @@ type TaskBuilder() =
         return! f result
     }
 
-    member _.Return x = task { return x }
-
-    member _.Zero() = task { return () }
+    // Bind overload to support awaiting a non-generic Task (do! someTask)
+    member _.Bind(x: Task, f: unit -> Task<'T>) : Task<'T> =
+        let tcs = new TaskCompletionSource<'T>()
+        x.ContinueWith(fun (t: Task) ->
+            if t.IsFaulted then tcs.SetException(t.Exception.InnerExceptions)
+            elif t.IsCanceled then tcs.SetCanceled()
+            else
+                try
+                    let next = f()
+                    next.ContinueWith(fun (n: Task<'T>) ->
+                        if n.IsFaulted then tcs.SetException(n.Exception.InnerExceptions)
+                        elif n.IsCanceled then tcs.SetCanceled()
+                        else tcs.SetResult(n.Result)
+                    ) |> ignore
+                with ex -> tcs.SetException(ex)
+        ) |> ignore
+        tcs.Task
 
+    // Return helpers so the computation expression can produce tasks directly
+    member _.Return(x: 'T) = Task.FromResult x
+    member _.ReturnFrom(x: Task<'T>) = x
+    member _.ReturnFrom(x: Task) = x
+    member _.Zero() = Task.FromResult ()
 
 let task = TaskBuilder()

DataParser.Console/data/fileformat_2020-10-15.txt

@@ -1,3 +1,3 @@
-Diabetes  1  1
-Asthma    0-14
+Diabetes 1  1
+Asthma   0-14
 Stroke    1122

DataParser.Console/specs/fileformat2.csv

@@ -1,4 +1,4 @@
-width,"column name",datatype
+width,"column nme",datatype
 10,name,TEXT
 1,valid,BOOLEAN
 3,count,INTEGER

qodana.yaml

@@ -0,0 +1,29 @@
+#-------------------------------------------------------------------------------#
+#               Qodana analysis is configured by qodana.yaml file               #
+#             https://www.jetbrains.com/help/qodana/qodana-yaml.html            #
+#-------------------------------------------------------------------------------#
+version: "1.0"
+
+#Specify IDE code to run analysis without container (Applied in CI/CD pipeline)
+ide: QDNET
+
+#Specify inspection profile for code analysis
+profile:
+  name: qodana.starter
+
+#Enable inspections
+#include:
+#  - name: <SomeEnabledInspectionId>
+
+#Disable inspections
+#exclude:
+#  - name: <SomeDisabledInspectionId>
+#    paths:
+#      - <path/where/not/run/inspection>
+
+#Execute shell command before Qodana execution (Applied in CI/CD pipeline)
+#bootstrap: sh ./prepare-qodana.sh
+
+#Install IDE plugins before Qodana execution (Applied in CI/CD pipeline)
+#plugins:
+#  - id: <plugin.id> #(plugin id can be found at https://plugins.jetbrains.com)