diff --git a/Fable.sln b/Fable.sln
index 8adccb6e07..b9aba20c23 100644
--- a/Fable.sln
+++ b/Fable.sln
@@ -62,6 +62,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fable.Tests.Spaces", "tests
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fable.Build", "src\Fable.Build\Fable.Build.fsproj", "{F2E323CE-FDF3-4A1E-AE97-B723D2E63763}"
EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fable.Compiler", "src\Fable.Compiler\Fable.Compiler.fsproj", "{942DD29B-07C0-4ACF-891E-85C1235A9BE0}"
+EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -160,6 +162,10 @@ Global
{F2E323CE-FDF3-4A1E-AE97-B723D2E63763}.Debug|Any CPU.Build.0 = Debug|Any CPU
{F2E323CE-FDF3-4A1E-AE97-B723D2E63763}.Release|Any CPU.ActiveCfg = Release|Any CPU
{F2E323CE-FDF3-4A1E-AE97-B723D2E63763}.Release|Any CPU.Build.0 = Release|Any CPU
+ {942DD29B-07C0-4ACF-891E-85C1235A9BE0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {942DD29B-07C0-4ACF-891E-85C1235A9BE0}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {942DD29B-07C0-4ACF-891E-85C1235A9BE0}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {942DD29B-07C0-4ACF-891E-85C1235A9BE0}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
@@ -189,6 +195,7 @@ Global
{F9134F40-C6CD-4368-A28E-33E5102FD4AB} = {CF0A8EC3-841F-4A54-B9FC-8D174CCD4A90}
{C90E23AF-4B5B-44A7-ADCC-3BF89547395B} = {DA29278E-3808-42DE-8333-964F129F295D}
{F2E323CE-FDF3-4A1E-AE97-B723D2E63763} = {C8CB96CF-68A8-4083-A0F8-319275CF8097}
+ {942DD29B-07C0-4ACF-891E-85C1235A9BE0} = {C8CB96CF-68A8-4083-A0F8-319275CF8097}
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {58DF9285-8523-4EAC-B598-BE5B02A76A00}
diff --git a/src/Fable.Build/Publish.fs b/src/Fable.Build/Publish.fs
index 10110d7347..41cf05e775 100644
--- a/src/Fable.Build/Publish.fs
+++ b/src/Fable.Build/Publish.fs
@@ -155,6 +155,7 @@ let handle (args: string list) =
publishNuget ProjectDir.fableAst
publishNuget ProjectDir.fableCore
+ publishNuget ProjectDir.fableCompiler
publishNuget ProjectDir.fableCli
publishNuget ProjectDir.fablePublishUtils
diff --git a/src/Fable.Build/Workspace.fs b/src/Fable.Build/Workspace.fs
index f7f64fa316..bc7179391a 100644
--- a/src/Fable.Build/Workspace.fs
+++ b/src/Fable.Build/Workspace.fs
@@ -11,6 +11,7 @@ module ProjectDir =
let fableCore = Path.Resolve("src", "Fable.Core")
let fableCli = Path.Resolve("src", "Fable.Cli")
let fablePublishUtils = Path.Resolve("src", "Fable.PublishUtils")
+ let fableCompiler = Path.Resolve("src", "Fable.Compiler")
let temp_fable_library = Path.Resolve("temp", "fable-library")
let fable_library = Path.Resolve("src", "fable-library")
let fable_metadata = Path.Resolve("src", "fable-metadata")
diff --git a/src/Fable.Cli/CHANGELOG.md b/src/Fable.Cli/CHANGELOG.md
index fc523e142a..1d12a6fd76 100644
--- a/src/Fable.Cli/CHANGELOG.md
+++ b/src/Fable.Cli/CHANGELOG.md
@@ -9,10 +9,19 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
### Fixed
+#### Rust
+
+* Fixed unary negation for signed integer MinValue (by @ncave)
+
+## 4.9.0 - 2023-12-14
+
+### Fixed
+
#### Python
* [GH-3655](https://github.com/fable-compiler/Fable/issues/3655) Fix for Python output file names (by @dbrattli)
* [GH-3660](https://github.com/fable-compiler/Fable/issues/3660) Fix for decimal to string with culture (by @dbrattli)
+* [GH-3666](https://github.com/fable-compiler/Fable/pull/3666) Fix for `DateTime` and `TimeSpan` addition (by @dbrattli)
#### Dart
diff --git a/src/Fable.Cli/Entry.fs b/src/Fable.Cli/Entry.fs
index d9394f949a..1d3b6c1f29 100644
--- a/src/Fable.Cli/Entry.fs
+++ b/src/Fable.Cli/Entry.fs
@@ -3,6 +3,7 @@ module Fable.Cli.Entry
open System
open Main
open Fable
+open Fable.Compiler.Util
type CliArgs(args: string list) =
let argsMap =
diff --git a/src/Fable.Cli/Fable.Cli.fsproj b/src/Fable.Cli/Fable.Cli.fsproj
index e77a33d9a0..efa9f0e4d8 100644
--- a/src/Fable.Cli/Fable.Cli.fsproj
+++ b/src/Fable.Cli/Fable.Cli.fsproj
@@ -4,9 +4,14 @@
true
Exe
net6.0
- 4.8.1
-
-- Fix the version reported by Fable (@MangelMaxime)
+ 4.9.0
+ ## Fixed
+
+
+### Python
+
+- [GH-3655](https://github.com/fable-compiler/Fable/issues/3655) Fix for Python output file names (by @dbrattli)
+- [GH-3660](https://github.com/fable-compiler/Fable/issues/3660) Fix for decimal to string with culture (by @dbrattli)
@@ -27,11 +32,7 @@
-
-
-
-
@@ -42,6 +43,7 @@
+
diff --git a/src/Fable.Cli/FileWatchers.fs b/src/Fable.Cli/FileWatchers.fs
index ae951624b9..6bf99809d8 100644
--- a/src/Fable.Cli/FileWatchers.fs
+++ b/src/Fable.Cli/FileWatchers.fs
@@ -12,7 +12,7 @@ open System.Threading
open System.Collections.Generic
open System.Diagnostics
open System.Text.RegularExpressions
-open Fable.Cli.Globbing
+open Fable.Compiler.Globbing
type IFileSystemWatcher =
inherit IDisposable
diff --git a/src/Fable.Cli/Globbing.fs b/src/Fable.Cli/Globbing.fs
deleted file mode 100644
index 12ba2152d6..0000000000
--- a/src/Fable.Cli/Globbing.fs
+++ /dev/null
@@ -1,512 +0,0 @@
-namespace Fable.Cli
-
-open System
-open System.Collections.Generic
-open System.IO
-
-/// Globbing support and operators
-///
-/// Forked from `Fake.IO.FileSystem`
-module Globbing =
- /// This module contains a file pattern globbing implementation.
- []
- module Glob =
- open System
- open System.Text.RegularExpressions
-
- // Normalizes path for different OS
- let inline normalizePath (path: string) =
- path
- .Replace('\\', Path.DirectorySeparatorChar)
- .Replace('/', Path.DirectorySeparatorChar)
-
- type private SearchOption =
- | Directory of string
- | Drive of string
- | Recursive
- | FilePattern of string
-
- let private checkSubDirs absolute (dir: string) root =
- if dir.Contains "*" then
- try
- Directory.EnumerateDirectories(
- root,
- dir,
- SearchOption.TopDirectoryOnly
- )
- |> Seq.toList
- with :? System.IO.DirectoryNotFoundException ->
- List.empty
- else
- let path = Path.Combine(root, dir)
-
- let di =
- if absolute then
- new DirectoryInfo(dir)
- else
- new DirectoryInfo(path)
-
- if di.Exists then
- [ di.FullName ]
- else
- []
-
- let rec private buildPaths acc (input: SearchOption list) =
- match input with
- | [] -> acc
- | Directory name :: t ->
- let subDirs = List.collect (checkSubDirs false name) acc
- buildPaths subDirs t
- | Drive name :: t ->
- let subDirs = List.collect (checkSubDirs true name) acc
- buildPaths subDirs t
- | Recursive :: [] ->
- let dirs =
- Seq.collect
- (fun dir ->
- try
- Directory.EnumerateFileSystemEntries(
- dir,
- "*",
- SearchOption.AllDirectories
- )
- with :? System.IO.DirectoryNotFoundException ->
- Seq.empty
- )
- acc
-
- buildPaths (acc @ Seq.toList dirs) []
- | Recursive :: t ->
- let dirs =
- Seq.collect
- (fun dir ->
- try
- Directory.EnumerateDirectories(
- dir,
- "*",
- SearchOption.AllDirectories
- )
- with :? System.IO.DirectoryNotFoundException ->
- Seq.empty
- )
- acc
-
- buildPaths (acc @ Seq.toList dirs) t
- | FilePattern pattern :: _ ->
- acc
- |> List.collect (fun dir ->
- if Directory.Exists(Path.Combine(dir, pattern)) then
- [ Path.Combine(dir, pattern) ]
- else
- try
- Directory.EnumerateFiles(dir, pattern)
- |> Seq.toList
- with
- | :? System.IO.DirectoryNotFoundException
- | :? System.IO.PathTooLongException -> []
- )
-
- let private driveRegex = Regex(@"^[A-Za-z]:$", RegexOptions.Compiled)
-
- let inline private normalizeOutputPath (p: string) =
- p
- .Replace('\\', Path.DirectorySeparatorChar)
- .Replace('/', Path.DirectorySeparatorChar)
- .TrimEnd(Path.DirectorySeparatorChar)
-
- let internal getRoot (baseDirectory: string) (pattern: string) =
- let baseDirectory = normalizePath baseDirectory
- let normPattern = normalizePath pattern
-
- let patternParts =
- normPattern.Split(
- [|
- '/'
- '\\'
- |],
- StringSplitOptions.RemoveEmptyEntries
- )
-
- let patternPathParts =
- patternParts
- |> Seq.takeWhile (fun p -> not (p.Contains("*")))
- |> Seq.toArray
-
- let globRoot =
- // If we did not find any "*", then drop the last bit (it is a file name, not a pattern)
- (if patternPathParts.Length = patternParts.Length then
- patternPathParts.[0 .. patternPathParts.Length - 2]
- else
- patternPathParts)
- |> String.concat (Path.DirectorySeparatorChar.ToString())
-
- let globRoot =
- // If we dropped "/" from the beginning of the path in the 'Split' call, put it back!
- if normPattern.StartsWith('/') then
- "/" + globRoot
- else
- globRoot
-
- if Path.IsPathRooted globRoot then
- globRoot
- else
- Path.Combine(baseDirectory, globRoot)
-
- let internal search (baseDir: string) (originalInput: string) =
- let baseDir = normalizePath baseDir
- let input = normalizePath originalInput
-
- let input =
- if String.IsNullOrEmpty baseDir then
- input
- else
- // The final \ (or /) makes sure to only match complete folder
- // names (as one folder name could be a substring of the other)
- let start =
- baseDir.TrimEnd([| Path.DirectorySeparatorChar |])
- + string Path.DirectorySeparatorChar
- // See https://github.com/fsharp/FAKE/issues/1925
- if input.StartsWith(start, StringComparison.Ordinal) then
- input.Substring start.Length
- else
- input
-
- let filePattern = Path.GetFileName(input)
-
- let splits =
- input.Split(
- [|
- '/'
- '\\'
- |],
- StringSplitOptions.None
- )
-
- let baseItems =
- let start, rest =
- if
- input.StartsWith("\\\\", StringComparison.Ordinal)
- && splits.Length >= 4
- then
- let serverName = splits.[2]
- let share = splits.[3]
-
- [ Directory(sprintf "\\\\%s\\%s" serverName share) ],
- splits |> Seq.skip 4
- elif
- splits.Length >= 2
- && Path.IsPathRooted input
- && driveRegex.IsMatch splits.[0]
- then
- [ Directory(splits.[0] + "\\") ], splits |> Seq.skip 1
- elif
- splits.Length >= 2
- && Path.IsPathRooted input
- && input.StartsWith '/'
- then
- [ Directory("/") ], splits |> Array.toSeq
- else
- if Path.IsPathRooted input then
- if input.StartsWith '\\' then
- failwithf
- "Please remove the leading '\\' or '/' and replace them with \
- '.\\' or './' if you want to use a relative path. Leading \
- slashes are considered an absolute path (input was '%s')!"
- originalInput
- else
- failwithf
- "Unknown globbing input '%s', try to use a \
- relative path and report an issue!"
- originalInput
-
- [], splits |> Array.toSeq
-
- let restList =
- rest
- |> Seq.filter (String.IsNullOrEmpty >> not)
- |> Seq.map (
- function
- | "**" -> Recursive
- | a when a = filePattern -> FilePattern(a)
- | a -> Directory(a)
- )
- |> Seq.toList
-
- start @ restList
-
- baseItems |> buildPaths [ baseDir ] |> List.map normalizeOutputPath
-
- let internal compileGlobToRegex pattern =
- let pattern = normalizePath pattern
-
- let escapedPattern = (Regex.Escape pattern)
-
- let regexPattern =
- let xTOy =
- [
- "dirwildcard", (@"\\\*\\\*(/|\\\\)", @"(.*(/|\\))?")
- "stardotstar", (@"\\\*\\.\\\*", @"([^\\/]*)")
- "wildcard", (@"\\\*", @"([^\\/]*)")
- ]
- |> List.map (fun (key, (pattern, replace)) ->
- let pattern = sprintf "(?<%s>%s)" key pattern
- key, (pattern, replace)
- )
-
- let xTOyMap = xTOy |> Map.ofList
-
- let replacePattern =
- xTOy
- |> List.map (fun x -> x |> snd |> fst)
- |> String.concat ("|")
-
- let replaced =
- Regex(replacePattern)
- .Replace(
- escapedPattern,
- fun m ->
- let matched =
- xTOy
- |> Seq.map (fst)
- |> Seq.find (fun n ->
- m.Groups.Item(n).Success
- )
-
- (xTOyMap |> Map.tryFind matched).Value |> snd
- )
-
- "^" + replaced + "$"
-
- Regex(regexPattern)
-
- let private globRegexCache =
- System.Collections.Concurrent.ConcurrentDictionary()
-
- let isMatch pattern path : bool =
- let path = normalizePath path
-
- let regex =
- let outRegex: ref = ref null
-
- if globRegexCache.TryGetValue(pattern, outRegex) then
- outRegex.Value
- else
- let compiled = compileGlobToRegex pattern
- globRegexCache.TryAdd(pattern, compiled) |> ignore
- compiled
-
- regex.IsMatch(path)
-
- type IGlobbingPattern =
- inherit IEnumerable
- abstract BaseDirectory: string
- abstract Includes: string list
- abstract Excludes: string list
-
- type LazyGlobbingPattern =
- {
- BaseDirectory: string
- Includes: string list
- Excludes: string list
- }
-
- interface IGlobbingPattern with
- member this.BaseDirectory = this.BaseDirectory
- member this.Includes = this.Includes
- member this.Excludes = this.Excludes
-
- interface IEnumerable with
-
- member this.GetEnumerator() =
- let hashSet = HashSet()
-
- let excludes =
- seq {
- for pattern in this.Excludes do
- yield! Glob.search this.BaseDirectory pattern
- }
- |> Set.ofSeq
-
- let files =
- seq {
- for pattern in this.Includes do
- yield! Glob.search this.BaseDirectory pattern
- }
- |> Seq.filter (fun x -> not (Set.contains x excludes))
- |> Seq.filter (fun x -> hashSet.Add x)
-
- files.GetEnumerator()
-
- member this.GetEnumerator() =
- (this :> IEnumerable).GetEnumerator()
- :> System.Collections.IEnumerator
-
- type ResolvedGlobbingPattern =
- {
- BaseDirectory: string
- Includes: string list
- Excludes: string list
- Results: string list
- }
-
- interface IGlobbingPattern with
- member this.BaseDirectory = this.BaseDirectory
- member this.Includes = this.Includes
- member this.Excludes = this.Excludes
-
- interface IEnumerable with
- member this.GetEnumerator() =
- (this.Results :> IEnumerable).GetEnumerator()
-
- member this.GetEnumerator() =
- (this :> IEnumerable).GetEnumerator()
- :> System.Collections.IEnumerator
-
- []
- module GlobbingPatternExtensions =
- type IGlobbingPattern with
-
- member internal this.Pattern =
- match this with
- | :? LazyGlobbingPattern as l -> l
- | _ ->
- {
- BaseDirectory = this.BaseDirectory
- Includes = this.Includes
- Excludes = this.Excludes
- }
-
- member this.Resolve() =
- match this with
- | :? ResolvedGlobbingPattern as res -> res :> IGlobbingPattern
- | _ ->
- let list = this |> Seq.toList
-
- {
- BaseDirectory = this.BaseDirectory
- Includes = this.Includes
- Excludes = this.Excludes
- Results = list
- }
- :> IGlobbingPattern
-
- /// Adds the given pattern to the file includes
- member this.And pattern =
- { this.Pattern with Includes = this.Includes @ [ pattern ] }
- :> IGlobbingPattern
-
- /// Ignores files with the given pattern
- member this.ButNot pattern =
- { this.Pattern with Excludes = pattern :: this.Excludes }
- :> IGlobbingPattern
-
- /// Sets a directory as BaseDirectory.
- member this.SetBaseDirectory(dir: string) =
- { this.Pattern with
- BaseDirectory = dir.TrimEnd(Path.DirectorySeparatorChar)
- }
- :> IGlobbingPattern
-
- /// Checks if a particular file is matched
- member this.IsMatch(path: string) =
- let fullDir (pattern: string) =
- if Path.IsPathRooted(pattern) then
- pattern
- else
- System.IO.Path.Combine(this.BaseDirectory, pattern)
-
- let fullPath = Path.GetFullPath path
-
- let included =
- this.Includes
- |> List.exists (fun fileInclude ->
- Glob.isMatch (fullDir fileInclude) fullPath
- )
-
- let excluded =
- this.Excludes
- |> List.exists (fun fileExclude ->
- Glob.isMatch (fullDir fileExclude) fullPath
- )
-
- included && not excluded
-
- []
- module GlobbingPattern =
- let private defaultBaseDir = Path.GetFullPath "."
-
- /// Include files
- let create x =
- {
- BaseDirectory = defaultBaseDir
- Includes = [ x ]
- Excludes = []
- }
- :> IGlobbingPattern
-
- /// Start an empty globbing pattern from the specified directory
- let createFrom (dir: string) =
- {
- BaseDirectory = dir
- Includes = []
- Excludes = []
- }
- :> IGlobbingPattern
-
- /// Sets a directory as baseDirectory for fileIncludes.
- let setBaseDir (dir: string) (fileIncludes: IGlobbingPattern) =
- fileIncludes.SetBaseDirectory dir
-
- /// Get base include directories.
- ///
- /// Used to get a smaller set of directories from a globbing pattern.
- let getBaseDirectoryIncludes (fileIncludes: IGlobbingPattern) =
- let directoryIncludes =
- fileIncludes.Includes
- |> Seq.map (fun file ->
- Glob.getRoot fileIncludes.BaseDirectory file
- )
-
- // remove subdirectories
- directoryIncludes
- |> Seq.filter (fun d ->
- directoryIncludes
- |> Seq.exists (fun p ->
- d.StartsWith(
- p + string Path.DirectorySeparatorChar,
- StringComparison.Ordinal
- )
- && p <> d
- )
- |> not
- )
- |> Seq.toList
-
- /// Contains operators to find and process files.
- ///
- /// ### Simple glob using as list
- ///
- /// let csProjectFiles = !! "src/*.csproj"
- ///
- /// for projectFile in csProjectFiles do
- /// printf "F# ProjectFile: %s" projectFile
- ///
- /// ### Combine globs
- ///
- /// let projectFiles =
- /// !! "src/*/*.*proj"
- /// ++ "src/*/*.target"
- /// -- "src/*/*.vbproj"
- ///
- /// for projectFile in projectFiles do
- /// printf "ProjectFile: %s" projectFile
- ///
- module Operators =
- /// Add Include operator
- let inline (++) (x: IGlobbingPattern) pattern = x.And pattern
-
- /// Exclude operator
- let inline (--) (x: IGlobbingPattern) pattern = x.ButNot pattern
-
- /// Includes a single pattern and scans the files - !! x = AllFilesMatching x
- let inline (!!) x = GlobbingPattern.create x
diff --git a/src/Fable.Cli/Main.fs b/src/Fable.Cli/Main.fs
index 64393506c2..422729a94d 100644
--- a/src/Fable.Cli/Main.fs
+++ b/src/Fable.Cli/Main.fs
@@ -12,7 +12,8 @@ open Fable
open Fable.AST
open Fable.Transforms
open Fable.Transforms.State
-open ProjectCracker
+open Fable.Compiler.ProjectCracker
+open Fable.Compiler.Util
module private Util =
type PathResolver with
@@ -122,7 +123,9 @@ module private Util =
let logErrors rootDir (logs: Log seq) =
logs
|> Seq.filter (fun log -> log.Severity = Severity.Error)
- |> Seq.iter (fun log -> Log.error (formatLog rootDir log))
+ |> Seq.iter (fun log ->
+ Fable.Compiler.Util.Log.error (formatLog rootDir log)
+ )
let getFSharpDiagnostics (diagnostics: FSharpDiagnostic array) =
diagnostics
@@ -435,29 +438,12 @@ type FsWatcher(delayMs: int) =
|> Observable.throttle delayMs
|> Observable.map caseInsensitiveSet
-// TODO: Check the path is actually normalized?
-type File(normalizedFullPath: string) =
- let mutable sourceHash = None
- member _.NormalizedFullPath = normalizedFullPath
-
- member _.ReadSource() =
- match sourceHash with
- | Some h -> h, lazy File.readAllTextNonBlocking normalizedFullPath
- | _ ->
- let source = File.readAllTextNonBlocking normalizedFullPath
- let h = hash source
- sourceHash <- Some h
- h, lazy source
-
- static member MakeSourceReader(files: File[]) =
- let fileDic =
- files |> Seq.map (fun f -> f.NormalizedFullPath, f) |> dict
-
- let sourceReader f = fileDic[f].ReadSource()
- files |> Array.map (fun file -> file.NormalizedFullPath), sourceReader
-
type ProjectCracked
- (cliArgs: CliArgs, crackerResponse: CrackerResponse, sourceFiles: File array)
+ (
+ cliArgs: CliArgs,
+ crackerResponse: CrackerResponse,
+ sourceFiles: Fable.Compiler.File array
+ )
=
member _.CliArgs = cliArgs
@@ -534,7 +520,9 @@ OUTPUT TYPE: {result.OutputType}
"Compiling project as Library. If you intend to run the code directly, please set OutputType to Exe."
| _ -> ()
- let sourceFiles = result.ProjectOptions.SourceFiles |> Array.map File
+ let sourceFiles =
+ result.ProjectOptions.SourceFiles |> Array.map Fable.Compiler.File
+
ProjectCracked(cliArgs, result, sourceFiles)
type FableCompileResult =
@@ -555,7 +543,7 @@ type ReplyChannel =
type FableCompilerMsg =
| GetFableProject of replyChannel: AsyncReplyChannel
| StartCompilation of
- sourceFiles: File[] *
+ sourceFiles: Fable.Compiler.File[] *
filesToCompile: string[] *
pathResolver: PathResolver *
isSilent: bool *
@@ -615,9 +603,9 @@ type FableCompilerState =
and FableCompiler
(
+ checker: InteractiveChecker,
projCracked: ProjectCracked,
- fableProj: Project,
- checker: InteractiveChecker
+ fableProj: Project
)
=
let agent =
@@ -708,7 +696,8 @@ and FableCompiler
FSharpCompilationFinished
(fun () ->
let filePaths, sourceReader =
- File.MakeSourceReader sourceFiles
+ Fable.Compiler.File.MakeSourceReader
+ sourceFiles
let subscriber =
if
@@ -932,12 +921,12 @@ and FableCompiler
getPlugin = loadType projCracked.CliArgs
)
- return FableCompiler(projCracked, fableProj, checker)
+ return FableCompiler(checker, projCracked, fableProj)
}
member _.CompileToFile(outFile: string) =
let filePaths, sourceReader =
- File.MakeSourceReader projCracked.SourceFiles
+ Fable.Compiler.File.MakeSourceReader projCracked.SourceFiles
checker.Compile(filePaths, sourceReader, outFile)
@@ -1051,7 +1040,7 @@ type State =
let private getFilesToCompile
(state: State)
(changes: ISet)
- (oldFiles: IDictionary option)
+ (oldFiles: IDictionary option)
(projCracked: ProjectCracked)
=
let pendingFiles = set state.PendingFiles
@@ -1060,7 +1049,7 @@ let private getFilesToCompile
let projCracked =
projCracked.MapSourceFiles(fun file ->
if changes.Contains(file.NormalizedFullPath) then
- File(file.NormalizedFullPath)
+ Fable.Compiler.File(file.NormalizedFullPath)
else
file
)
diff --git a/src/Fable.Cli/Pipeline.fs b/src/Fable.Cli/Pipeline.fs
index 78b9be37ff..56e675bdae 100644
--- a/src/Fable.Cli/Pipeline.fs
+++ b/src/Fable.Cli/Pipeline.fs
@@ -4,6 +4,7 @@ open System
open Fable
open Fable.AST
open Fable.Transforms
+open Fable.Compiler.Util
type Stream =
static member WriteToFile(memoryStream: IO.Stream, filePath: string) =
diff --git a/src/Fable.Cli/Printers.fs b/src/Fable.Cli/Printers.fs
index 70db45760c..809320f15b 100644
--- a/src/Fable.Cli/Printers.fs
+++ b/src/Fable.Cli/Printers.fs
@@ -3,6 +3,7 @@ module Fable.Cli.Printers
open System.IO
open FSharp.Compiler.Symbols
open Fable
+open Fable.Compiler.Util
let attribsOfSymbol (s: FSharpSymbol) =
[
diff --git a/src/Fable.Compiler/CHANGELOG.md b/src/Fable.Compiler/CHANGELOG.md
new file mode 100644
index 0000000000..2a0d67eadd
--- /dev/null
+++ b/src/Fable.Compiler/CHANGELOG.md
@@ -0,0 +1,16 @@
+# Changelog
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
+
+## Unreleased
+
+## 4.0.0-alpha-001 - 2023-12-14
+
+* Initial release
+
+## 4.0.0-beta-001 - 2023-12-14 [YANKED]
+
+* Initial release
diff --git a/src/Fable.Compiler/Fable.Compiler.fsproj b/src/Fable.Compiler/Fable.Compiler.fsproj
new file mode 100644
index 0000000000..7bdedaed52
--- /dev/null
+++ b/src/Fable.Compiler/Fable.Compiler.fsproj
@@ -0,0 +1,55 @@
+
+
+
+ net6.0
+ true
+ true
+ true
+ Fable.Compiler
+ 4.0.0-alpha-001
+
+- Initial release
+
+
+ embedded
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/Fable.Compiler/File.fs b/src/Fable.Compiler/File.fs
new file mode 100644
index 0000000000..724a23f819
--- /dev/null
+++ b/src/Fable.Compiler/File.fs
@@ -0,0 +1,41 @@
+namespace Fable.Compiler
+
+open System.IO
+
+// TODO: Check the path is actually normalized?
+type File(normalizedFullPath: string) =
+ let mutable sourceHash = None
+
+ let readAllTextNonBlocking (path: string) =
+ if File.Exists(path) then
+ use fileStream =
+ new FileStream(
+ path,
+ FileMode.Open,
+ FileAccess.Read,
+ FileShare.ReadWrite
+ )
+
+ use textReader = new StreamReader(fileStream)
+ textReader.ReadToEnd()
+ else
+ // Log.always("File does not exist: " + path)
+ ""
+
+ member _.NormalizedFullPath = normalizedFullPath
+
+ member _.ReadSource() =
+ match sourceHash with
+ | Some h -> h, lazy readAllTextNonBlocking normalizedFullPath
+ | _ ->
+ let source = readAllTextNonBlocking normalizedFullPath
+ let h = hash source
+ sourceHash <- Some h
+ h, lazy source
+
+ static member MakeSourceReader(files: File array) =
+ let fileDic =
+ files |> Seq.map (fun f -> f.NormalizedFullPath, f) |> dict
+
+ let sourceReader f = fileDic[f].ReadSource()
+ files |> Array.map (fun file -> file.NormalizedFullPath), sourceReader
diff --git a/src/Fable.Compiler/Globbing.fs b/src/Fable.Compiler/Globbing.fs
new file mode 100644
index 0000000000..c8c5db7bc2
--- /dev/null
+++ b/src/Fable.Compiler/Globbing.fs
@@ -0,0 +1,509 @@
+module Fable.Compiler.Globbing
+
+open System
+open System.Collections.Generic
+open System.IO
+
+/// Globbing support and operators
+///
+/// Forked from `Fake.IO.FileSystem`
+///
+/// This module contains a file pattern globbing implementation.
+[]
+module Glob =
+ open System
+ open System.Text.RegularExpressions
+
+ // Normalizes path for different OS
+ let inline normalizePath (path: string) =
+ path
+ .Replace('\\', Path.DirectorySeparatorChar)
+ .Replace('/', Path.DirectorySeparatorChar)
+
+ type private SearchOption =
+ | Directory of string
+ | Drive of string
+ | Recursive
+ | FilePattern of string
+
+ let private checkSubDirs absolute (dir: string) root =
+ if dir.Contains "*" then
+ try
+ Directory.EnumerateDirectories(
+ root,
+ dir,
+ SearchOption.TopDirectoryOnly
+ )
+ |> Seq.toList
+ with :? System.IO.DirectoryNotFoundException ->
+ List.empty
+ else
+ let path = Path.Combine(root, dir)
+
+ let di =
+ if absolute then
+ new DirectoryInfo(dir)
+ else
+ new DirectoryInfo(path)
+
+ if di.Exists then
+ [ di.FullName ]
+ else
+ []
+
+ let rec private buildPaths acc (input: SearchOption list) =
+ match input with
+ | [] -> acc
+ | Directory name :: t ->
+ let subDirs = List.collect (checkSubDirs false name) acc
+ buildPaths subDirs t
+ | Drive name :: t ->
+ let subDirs = List.collect (checkSubDirs true name) acc
+ buildPaths subDirs t
+ | Recursive :: [] ->
+ let dirs =
+ Seq.collect
+ (fun dir ->
+ try
+ Directory.EnumerateFileSystemEntries(
+ dir,
+ "*",
+ SearchOption.AllDirectories
+ )
+ with :? System.IO.DirectoryNotFoundException ->
+ Seq.empty
+ )
+ acc
+
+ buildPaths (acc @ Seq.toList dirs) []
+ | Recursive :: t ->
+ let dirs =
+ Seq.collect
+ (fun dir ->
+ try
+ Directory.EnumerateDirectories(
+ dir,
+ "*",
+ SearchOption.AllDirectories
+ )
+ with :? System.IO.DirectoryNotFoundException ->
+ Seq.empty
+ )
+ acc
+
+ buildPaths (acc @ Seq.toList dirs) t
+ | FilePattern pattern :: _ ->
+ acc
+ |> List.collect (fun dir ->
+ if Directory.Exists(Path.Combine(dir, pattern)) then
+ [ Path.Combine(dir, pattern) ]
+ else
+ try
+ Directory.EnumerateFiles(dir, pattern) |> Seq.toList
+ with
+ | :? System.IO.DirectoryNotFoundException
+ | :? System.IO.PathTooLongException -> []
+ )
+
+ let private driveRegex = Regex(@"^[A-Za-z]:$", RegexOptions.Compiled)
+
+ let inline private normalizeOutputPath (p: string) =
+ p
+ .Replace('\\', Path.DirectorySeparatorChar)
+ .Replace('/', Path.DirectorySeparatorChar)
+ .TrimEnd(Path.DirectorySeparatorChar)
+
+ let internal getRoot (baseDirectory: string) (pattern: string) =
+ let baseDirectory = normalizePath baseDirectory
+ let normPattern = normalizePath pattern
+
+ let patternParts =
+ normPattern.Split(
+ [|
+ '/'
+ '\\'
+ |],
+ StringSplitOptions.RemoveEmptyEntries
+ )
+
+ let patternPathParts =
+ patternParts
+ |> Seq.takeWhile (fun p -> not (p.Contains("*")))
+ |> Seq.toArray
+
+ let globRoot =
+ // If we did not find any "*", then drop the last bit (it is a file name, not a pattern)
+ (if patternPathParts.Length = patternParts.Length then
+ patternPathParts.[0 .. patternPathParts.Length - 2]
+ else
+ patternPathParts)
+ |> String.concat (Path.DirectorySeparatorChar.ToString())
+
+ let globRoot =
+ // If we dropped "/" from the beginning of the path in the 'Split' call, put it back!
+ if normPattern.StartsWith('/') then
+ "/" + globRoot
+ else
+ globRoot
+
+ if Path.IsPathRooted globRoot then
+ globRoot
+ else
+ Path.Combine(baseDirectory, globRoot)
+
+ let internal search (baseDir: string) (originalInput: string) =
+ let baseDir = normalizePath baseDir
+ let input = normalizePath originalInput
+
+ let input =
+ if String.IsNullOrEmpty baseDir then
+ input
+ else
+ // The final \ (or /) makes sure to only match complete folder
+ // names (as one folder name could be a substring of the other)
+ let start =
+ baseDir.TrimEnd([| Path.DirectorySeparatorChar |])
+ + string Path.DirectorySeparatorChar
+ // See https://github.com/fsharp/FAKE/issues/1925
+ if input.StartsWith(start, StringComparison.Ordinal) then
+ input.Substring start.Length
+ else
+ input
+
+ let filePattern = Path.GetFileName(input)
+
+ let splits =
+ input.Split(
+ [|
+ '/'
+ '\\'
+ |],
+ StringSplitOptions.None
+ )
+
+ let baseItems =
+ let start, rest =
+ if
+ input.StartsWith("\\\\", StringComparison.Ordinal)
+ && splits.Length >= 4
+ then
+ let serverName = splits.[2]
+ let share = splits.[3]
+
+ [ Directory(sprintf "\\\\%s\\%s" serverName share) ],
+ splits |> Seq.skip 4
+ elif
+ splits.Length >= 2
+ && Path.IsPathRooted input
+ && driveRegex.IsMatch splits.[0]
+ then
+ [ Directory(splits.[0] + "\\") ], splits |> Seq.skip 1
+ elif
+ splits.Length >= 2
+ && Path.IsPathRooted input
+ && input.StartsWith '/'
+ then
+ [ Directory("/") ], splits |> Array.toSeq
+ else
+ if Path.IsPathRooted input then
+ if input.StartsWith '\\' then
+ failwithf
+ "Please remove the leading '\\' or '/' and replace them with \
+ '.\\' or './' if you want to use a relative path. Leading \
+ slashes are considered an absolute path (input was '%s')!"
+ originalInput
+ else
+ failwithf
+ "Unknown globbing input '%s', try to use a \
+ relative path and report an issue!"
+ originalInput
+
+ [], splits |> Array.toSeq
+
+ let restList =
+ rest
+ |> Seq.filter (String.IsNullOrEmpty >> not)
+ |> Seq.map (
+ function
+ | "**" -> Recursive
+ | a when a = filePattern -> FilePattern(a)
+ | a -> Directory(a)
+ )
+ |> Seq.toList
+
+ start @ restList
+
+ baseItems |> buildPaths [ baseDir ] |> List.map normalizeOutputPath
+
+ let internal compileGlobToRegex pattern =
+ let pattern = normalizePath pattern
+
+ let escapedPattern = (Regex.Escape pattern)
+
+ let regexPattern =
+ let xTOy =
+ [
+ "dirwildcard", (@"\\\*\\\*(/|\\\\)", @"(.*(/|\\))?")
+ "stardotstar", (@"\\\*\\.\\\*", @"([^\\/]*)")
+ "wildcard", (@"\\\*", @"([^\\/]*)")
+ ]
+ |> List.map (fun (key, (pattern, replace)) ->
+ let pattern = sprintf "(?<%s>%s)" key pattern
+ key, (pattern, replace)
+ )
+
+ let xTOyMap = xTOy |> Map.ofList
+
+ let replacePattern =
+ xTOy
+ |> List.map (fun x -> x |> snd |> fst)
+ |> String.concat ("|")
+
+ let replaced =
+ Regex(replacePattern)
+ .Replace(
+ escapedPattern,
+ fun m ->
+ let matched =
+ xTOy
+ |> Seq.map (fst)
+ |> Seq.find (fun n -> m.Groups.Item(n).Success)
+
+ (xTOyMap |> Map.tryFind matched).Value |> snd
+ )
+
+ "^" + replaced + "$"
+
+ Regex(regexPattern)
+
+ let private globRegexCache =
+ System.Collections.Concurrent.ConcurrentDictionary()
+
+ let isMatch pattern path : bool =
+ let path = normalizePath path
+
+ let regex =
+ let outRegex: ref = ref null
+
+ if globRegexCache.TryGetValue(pattern, outRegex) then
+ outRegex.Value
+ else
+ let compiled = compileGlobToRegex pattern
+ globRegexCache.TryAdd(pattern, compiled) |> ignore
+ compiled
+
+ regex.IsMatch(path)
+
+type IGlobbingPattern =
+ inherit IEnumerable
+ abstract BaseDirectory: string
+ abstract Includes: string list
+ abstract Excludes: string list
+
+type LazyGlobbingPattern =
+ {
+ BaseDirectory: string
+ Includes: string list
+ Excludes: string list
+ }
+
+ interface IGlobbingPattern with
+ member this.BaseDirectory = this.BaseDirectory
+ member this.Includes = this.Includes
+ member this.Excludes = this.Excludes
+
+ interface IEnumerable with
+
+ member this.GetEnumerator() =
+ let hashSet = HashSet()
+
+ let excludes =
+ seq {
+ for pattern in this.Excludes do
+ yield! Glob.search this.BaseDirectory pattern
+ }
+ |> Set.ofSeq
+
+ let files =
+ seq {
+ for pattern in this.Includes do
+ yield! Glob.search this.BaseDirectory pattern
+ }
+ |> Seq.filter (fun x -> not (Set.contains x excludes))
+ |> Seq.filter (fun x -> hashSet.Add x)
+
+ files.GetEnumerator()
+
+ member this.GetEnumerator() =
+ (this :> IEnumerable).GetEnumerator()
+ :> System.Collections.IEnumerator
+
+type ResolvedGlobbingPattern =
+ {
+ BaseDirectory: string
+ Includes: string list
+ Excludes: string list
+ Results: string list
+ }
+
+ interface IGlobbingPattern with
+ member this.BaseDirectory = this.BaseDirectory
+ member this.Includes = this.Includes
+ member this.Excludes = this.Excludes
+
+ interface IEnumerable with
+ member this.GetEnumerator() =
+ (this.Results :> IEnumerable).GetEnumerator()
+
+ member this.GetEnumerator() =
+ (this :> IEnumerable).GetEnumerator()
+ :> System.Collections.IEnumerator
+
+[]
+module GlobbingPatternExtensions =
+ type IGlobbingPattern with
+
+ member internal this.Pattern =
+ match this with
+ | :? LazyGlobbingPattern as l -> l
+ | _ ->
+ {
+ BaseDirectory = this.BaseDirectory
+ Includes = this.Includes
+ Excludes = this.Excludes
+ }
+
+ member this.Resolve() =
+ match this with
+ | :? ResolvedGlobbingPattern as res -> res :> IGlobbingPattern
+ | _ ->
+ let list = this |> Seq.toList
+
+ {
+ BaseDirectory = this.BaseDirectory
+ Includes = this.Includes
+ Excludes = this.Excludes
+ Results = list
+ }
+ :> IGlobbingPattern
+
+ /// Adds the given pattern to the file includes
+ member this.And pattern =
+ { this.Pattern with Includes = this.Includes @ [ pattern ] }
+ :> IGlobbingPattern
+
+ /// Ignores files with the given pattern
+ member this.ButNot pattern =
+ { this.Pattern with Excludes = pattern :: this.Excludes }
+ :> IGlobbingPattern
+
+ /// Sets a directory as BaseDirectory.
+ member this.SetBaseDirectory(dir: string) =
+ { this.Pattern with
+ BaseDirectory = dir.TrimEnd(Path.DirectorySeparatorChar)
+ }
+ :> IGlobbingPattern
+
+ /// Checks if a particular file is matched
+ member this.IsMatch(path: string) =
+ let fullDir (pattern: string) =
+ if Path.IsPathRooted(pattern) then
+ pattern
+ else
+ System.IO.Path.Combine(this.BaseDirectory, pattern)
+
+ let fullPath = Path.GetFullPath path
+
+ let included =
+ this.Includes
+ |> List.exists (fun fileInclude ->
+ Glob.isMatch (fullDir fileInclude) fullPath
+ )
+
+ let excluded =
+ this.Excludes
+ |> List.exists (fun fileExclude ->
+ Glob.isMatch (fullDir fileExclude) fullPath
+ )
+
+ included && not excluded
+
+[]
+module GlobbingPattern =
+ let private defaultBaseDir = Path.GetFullPath "."
+
+ /// Include files
+ let create x =
+ {
+ BaseDirectory = defaultBaseDir
+ Includes = [ x ]
+ Excludes = []
+ }
+ :> IGlobbingPattern
+
+ /// Start an empty globbing pattern from the specified directory
+ let createFrom (dir: string) =
+ {
+ BaseDirectory = dir
+ Includes = []
+ Excludes = []
+ }
+ :> IGlobbingPattern
+
+ /// Sets a directory as baseDirectory for fileIncludes.
+ let setBaseDir (dir: string) (fileIncludes: IGlobbingPattern) =
+ fileIncludes.SetBaseDirectory dir
+
+ /// Get base include directories.
+ ///
+ /// Used to get a smaller set of directories from a globbing pattern.
+ let getBaseDirectoryIncludes (fileIncludes: IGlobbingPattern) =
+ let directoryIncludes =
+ fileIncludes.Includes
+ |> Seq.map (fun file ->
+ Glob.getRoot fileIncludes.BaseDirectory file
+ )
+
+ // remove subdirectories
+ directoryIncludes
+ |> Seq.filter (fun d ->
+ directoryIncludes
+ |> Seq.exists (fun p ->
+ d.StartsWith(
+ p + string Path.DirectorySeparatorChar,
+ StringComparison.Ordinal
+ )
+ && p <> d
+ )
+ |> not
+ )
+ |> Seq.toList
+
+/// Contains operators to find and process files.
+///
+/// ### Simple glob using as list
+///
+/// let csProjectFiles = !! "src/*.csproj"
+///
+/// for projectFile in csProjectFiles do
+/// printf "F# ProjectFile: %s" projectFile
+///
+/// ### Combine globs
+///
+/// let projectFiles =
+/// !! "src/*/*.*proj"
+/// ++ "src/*/*.target"
+/// -- "src/*/*.vbproj"
+///
+/// for projectFile in projectFiles do
+/// printf "ProjectFile: %s" projectFile
+///
+module Operators =
+ /// Add Include operator
+ let inline (++) (x: IGlobbingPattern) pattern = x.And pattern
+
+ /// Exclude operator
+ let inline (--) (x: IGlobbingPattern) pattern = x.ButNot pattern
+
+ /// Includes a single pattern and scans the files - !! x = AllFilesMatching x
+ let inline (!!) x = GlobbingPattern.create x
diff --git a/src/Fable.Compiler/Globbing.fsi b/src/Fable.Compiler/Globbing.fsi
new file mode 100644
index 0000000000..4bae9ad036
--- /dev/null
+++ b/src/Fable.Compiler/Globbing.fsi
@@ -0,0 +1,112 @@
+module Fable.Compiler.Globbing
+
+open System.Collections.Generic
+open System.IO
+
+/// Globbing support and operators
+///
+/// Forked from `Fake.IO.FileSystem`
+///
+/// This module contains a file pattern globbing implementation.
+[]
+module Glob =
+ open System
+ open System.Text.RegularExpressions
+
+ val inline normalizePath: path: string -> string
+
+ type private SearchOption =
+ | Directory of string
+ | Drive of string
+ | Recursive
+ | FilePattern of string
+
+ val internal getRoot: baseDirectory: string -> pattern: string -> string
+ val internal search: baseDir: string -> originalInput: string -> string list
+ val internal compileGlobToRegex: pattern: string -> Regex
+ val isMatch: pattern: string -> path: string -> bool
+
+type IGlobbingPattern =
+ inherit IEnumerable
+ abstract BaseDirectory: string
+ abstract Includes: string list
+ abstract Excludes: string list
+
+type LazyGlobbingPattern =
+ {
+ BaseDirectory: string
+ Includes: string list
+ Excludes: string list
+ }
+
+ interface IGlobbingPattern
+ interface IEnumerable
+
+type ResolvedGlobbingPattern =
+ {
+ BaseDirectory: string
+ Includes: string list
+ Excludes: string list
+ Results: string list
+ }
+
+ interface IGlobbingPattern
+ interface IEnumerable
+
+[]
+module GlobbingPatternExtensions =
+ type IGlobbingPattern with
+
+ member internal Pattern: LazyGlobbingPattern
+ member Resolve: unit -> IGlobbingPattern
+ /// Adds the given pattern to the file includes
+ member And: pattern: string -> IGlobbingPattern
+ /// Ignores files with the given pattern
+ member ButNot: pattern: string -> IGlobbingPattern
+ /// Sets a directory as BaseDirectory.
+ member SetBaseDirectory: dir: string -> IGlobbingPattern
+ /// Checks if a particular file is matched
+ member IsMatch: path: string -> bool
+
+[]
+module GlobbingPattern =
+ /// Include files
+ val create: x: string -> IGlobbingPattern
+ /// Start an empty globbing pattern from the specified directory
+ val createFrom: dir: string -> IGlobbingPattern
+
+ /// Sets a directory as baseDirectory for fileIncludes.
+ val setBaseDir:
+ dir: string -> fileIncludes: IGlobbingPattern -> IGlobbingPattern
+
+ /// Get base include directories.
+ ///
+ /// Used to get a smaller set of directories from a globbing pattern.
+ val getBaseDirectoryIncludes: fileIncludes: IGlobbingPattern -> string list
+
+/// Contains operators to find and process files.
+///
+/// ### Simple glob using as list
+///
+/// let csProjectFiles = !! "src/*.csproj"
+///
+/// for projectFile in csProjectFiles do
+/// printf "F# ProjectFile: %s" projectFile
+///
+/// ### Combine globs
+///
+/// let projectFiles =
+/// !! "src/*/*.*proj"
+/// ++ "src/*/*.target"
+/// -- "src/*/*.vbproj"
+///
+/// for projectFile in projectFiles do
+/// printf "ProjectFile: %s" projectFile
+///
+module Operators =
+ /// Add Include operator
+ val inline (++): x: IGlobbingPattern -> pattern: string -> IGlobbingPattern
+ /// Exclude operator
+ val inline (--): x: IGlobbingPattern -> pattern: string -> IGlobbingPattern
+ /// Includes a single pattern and scans the files - !! x = AllFilesMatching x
+ val inline (!!): x: string -> IGlobbingPattern
diff --git a/src/Fable.Compiler/Library.fs b/src/Fable.Compiler/Library.fs
new file mode 100644
index 0000000000..799003610e
--- /dev/null
+++ b/src/Fable.Compiler/Library.fs
@@ -0,0 +1,271 @@
+module Fable.Compiler.CodeServices
+
+open System
+open System.IO
+open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.SourceCodeServices
+open Fable
+open Fable.Compiler.Util
+open Fable.Transforms.State
+open Fable.Transforms
+open Fable.Compiler.ProjectCracker
+
+type BabelWriter
+ (
+ com: Compiler,
+ pathResolver: PathResolver,
+ projectFile: string,
+ sourcePath: string,
+ targetPath: string
+ )
+ =
+ // In imports *.ts extensions have to be converted to *.js extensions instead
+ // TODO: incomplete
+ let fileExt = ".js"
+ let sourceDir = Path.GetDirectoryName(sourcePath)
+ let targetDir = Path.GetDirectoryName(targetPath)
+ let memoryStream = new MemoryStream()
+ let streamWriter = new StreamWriter(memoryStream)
+ do streamWriter.NewLine <- "\n"
+
+ // let mapGenerator = lazy (SourceMapSharp.SourceMapGenerator(?sourceRoot = cliArgs.SourceMapsRoot))
+
+ member x.ReadContentAsString() : Async =
+ async {
+ do! streamWriter.FlushAsync() |> Async.AwaitTask
+ memoryStream.Position <- 0L
+ let streamReader = new StreamReader(memoryStream)
+ return! (streamReader.ReadToEndAsync() |> Async.AwaitTask)
+ }
+
+ interface Printer.Writer with
+ // Don't dispose the stream here because we need to access the memory stream to check if file has changed
+ member _.Dispose() = ()
+
+ member _.Write(str) =
+ streamWriter.WriteAsync(str) |> Async.AwaitTask
+
+ member _.MakeImportPath(path) =
+ let projDir = Path.GetDirectoryName(projectFile)
+
+ let path =
+ // TODO: Check precompiled out path for other languages too
+ match pathResolver.TryPrecompiledOutPath(sourceDir, path) with
+ | Some path -> Imports.getRelativePath sourceDir path
+ | None -> path
+
+ // TODO: used to be cliArgs.outDir, could be wrong.
+ let path =
+ Imports.getImportPath
+ pathResolver
+ sourcePath
+ targetPath
+ projDir
+ (Some targetDir)
+ path
+
+ if path.EndsWith(".fs", StringComparison.Ordinal) then
+ let isInFableModules =
+ Path.Combine(targetDir, path) |> Naming.isInFableModules
+
+ File.changeExtensionButUseDefaultExtensionInFableModules
+ JavaScript
+ isInFableModules
+ path
+ fileExt
+ else
+ path
+
+ member _.AddLog(msg, severity, ?range) =
+ com.AddLog(
+ msg,
+ severity,
+ ?range = range,
+ fileName = com.CurrentFile
+ )
+
+ member _.AddSourceMapping
+ (
+ srcLine,
+ srcCol,
+ genLine,
+ genCol,
+ file,
+ displayName
+ )
+ =
+ //
+ ()
+// if cliArgs.SourceMaps then
+// let generated: SourceMapSharp.Util.MappingIndex = { line = genLine; column = genCol }
+// let original: SourceMapSharp.Util.MappingIndex = { line = srcLine; column = srcCol }
+// let targetPath = Path.normalizeFullPath targetPath
+// let sourcePath = defaultArg file sourcePath |> Path.getRelativeFileOrDirPath false targetPath false
+// mapGenerator.Force().AddMapping(generated, original, source=sourcePath, ?name=displayName)
+
+let compileFileToJs
+ (com: Compiler)
+ (pathResolver: PathResolver)
+ (outPath: string)
+ : Async
+ =
+ async {
+ let babel =
+ FSharp2Fable.Compiler.transformFile com
+ |> FableTransforms.transformFile com
+ |> Fable2Babel.Compiler.transformFile com
+
+ use writer =
+ new BabelWriter(
+ com,
+ pathResolver,
+ com.ProjectFile,
+ com.CurrentFile,
+ outPath
+ )
+
+ do! BabelPrinter.run writer babel
+ let! output = writer.ReadContentAsString()
+ return output
+ }
+
+let compileProjectToJavaScript
+ (sourceReader: SourceReader)
+ (checker: InteractiveChecker)
+ (pathResolver: PathResolver)
+ (cliArgs: CliArgs)
+ (crackerResponse: CrackerResponse)
+ : Async
diff --git a/src/Fable.Transforms/Rust/Fable2Rust.fs b/src/Fable.Transforms/Rust/Fable2Rust.fs
index a74ee2c1bc..1e7bf42b67 100644
--- a/src/Fable.Transforms/Rust/Fable2Rust.fs
+++ b/src/Fable.Transforms/Rust/Fable2Rust.fs
@@ -1869,199 +1869,91 @@ module Util =
else
expr |> mkAddrOfExpr
+ let negateWhen isNegative expr =
+ if isNegative then
+ expr |> mkNegExpr
+ else
+ expr
+
let makeNumber com ctx r t kind (x: obj) =
match kind, x with
| Int8, (:? int8 as x) when x = System.SByte.MinValue ->
- mkGenericPathExpr
- [
- "i8"
- "MIN"
- ]
- None
+ mkGenericPathExpr ("i8" :: "MIN" :: []) None
| Int8, (:? int8 as x) when x = System.SByte.MaxValue ->
- mkGenericPathExpr
- [
- "i8"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("i8" :: "MAX" :: []) None
| Int16, (:? int16 as x) when x = System.Int16.MinValue ->
- mkGenericPathExpr
- [
- "i16"
- "MIN"
- ]
- None
+ mkGenericPathExpr ("i16" :: "MIN" :: []) None
| Int16, (:? int16 as x) when x = System.Int16.MaxValue ->
- mkGenericPathExpr
- [
- "i16"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("i16" :: "MAX" :: []) None
| Int32, (:? int32 as x) when x = System.Int32.MinValue ->
- mkGenericPathExpr
- [
- "i32"
- "MIN"
- ]
- None
+ mkGenericPathExpr ("i32" :: "MIN" :: []) None
| Int32, (:? int32 as x) when x = System.Int32.MaxValue ->
- mkGenericPathExpr
- [
- "i32"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("i32" :: "MAX" :: []) None
| Int64, (:? int64 as x) when x = System.Int64.MinValue ->
- mkGenericPathExpr
- [
- "i64"
- "MIN"
- ]
- None
+ mkGenericPathExpr ("i64" :: "MIN" :: []) None
| Int64, (:? int64 as x) when x = System.Int64.MaxValue ->
- mkGenericPathExpr
- [
- "i64"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("i64" :: "MAX" :: []) None
// | Int128, (:? System.Int128 as x) when x = System.Int128.MinValue ->
- // mkGenericPathExpr ["i128";"MIN"] None
+ // mkGenericPathExpr ("i128"::"MIN"::[]) None
// | Int128, (:? System.Int128 as x) when x = System.Int128.MaxValue ->
- // mkGenericPathExpr ["i128";"MAX"] None
+ // mkGenericPathExpr ("i128"::"MAX"::[]) None
// | UInt8, (:? uint8 as x) when x = System.Byte.MinValue ->
- // mkGenericPathExpr ["u8";"MIN"] None
+ // mkGenericPathExpr ("u8"::"MIN"::[]) None
| UInt8, (:? uint8 as x) when x = System.Byte.MaxValue ->
- mkGenericPathExpr
- [
- "u8"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("u8" :: "MAX" :: []) None
// | UInt16, (:? uint16 as x) when x = System.UInt16.MinValue ->
- // mkGenericPathExpr ["u16";"MIN"] None
+ // mkGenericPathExpr ("u16"::"MIN"::[]) None
| UInt16, (:? uint16 as x) when x = System.UInt16.MaxValue ->
- mkGenericPathExpr
- [
- "u16"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("u16" :: "MAX" :: []) None
// | UInt32, (:? uint32 as x) when x = System.UInt32.MinValue ->
- // mkGenericPathExpr ["u32";"MIN"] None
+ // mkGenericPathExpr ("u32"::"MIN"::[]) None
| UInt32, (:? uint32 as x) when x = System.UInt32.MaxValue ->
- mkGenericPathExpr
- [
- "u32"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("u32" :: "MAX" :: []) None
// | UInt64, (:? uint64 as x) when x = System.UInt64.MinValue ->
- // mkGenericPathExpr ["u64";"MIN"] None
+ // mkGenericPathExpr ("u64"::"MIN"::[]) None
| UInt64, (:? uint64 as x) when x = System.UInt64.MaxValue ->
- mkGenericPathExpr
- [
- "u64"
- "MAX"
- ]
- None
+ mkGenericPathExpr ("u64" :: "MAX" :: []) None
// | UInt128, (:? System.UInt128 as x) when x = System.UInt128.MinValue ->
- // mkGenericPathExpr ["u128";"MIN"] None
+ // mkGenericPathExpr ("u128"::"MIN"::[]) None
// | UInt128, (:? System.UInt128 as x) when x = System.UInt128.MaxValue ->
- // mkGenericPathExpr ["u128";"MAX"] None
+ // mkGenericPathExpr ("u128"::"MAX"::[]) None
| Float32, (:? float32 as x) when System.Single.IsNaN(x) ->
- mkGenericPathExpr
- [
- "f32"
- "NAN"
- ]
- None
+ mkGenericPathExpr ("f32" :: "NAN" :: []) None
| Float64, (:? float as x) when System.Double.IsNaN(x) ->
- mkGenericPathExpr
- [
- "f64"
- "NAN"
- ]
- None
+ mkGenericPathExpr ("f64" :: "NAN" :: []) None
| Float32, (:? float32 as x) when System.Single.IsPositiveInfinity(x) ->
- mkGenericPathExpr
- [
- "f32"
- "INFINITY"
- ]
- None
+ mkGenericPathExpr ("f32" :: "INFINITY" :: []) None
| Float64, (:? float as x) when System.Double.IsPositiveInfinity(x) ->
- mkGenericPathExpr
- [
- "f64"
- "INFINITY"
- ]
- None
+ mkGenericPathExpr ("f64" :: "INFINITY" :: []) None
| Float32, (:? float32 as x) when System.Single.IsNegativeInfinity(x) ->
- mkGenericPathExpr
- [
- "f32"
- "NEG_INFINITY"
- ]
- None
+ mkGenericPathExpr ("f32" :: "NEG_INFINITY" :: []) None
| Float64, (:? float as x) when System.Double.IsNegativeInfinity(x) ->
- mkGenericPathExpr
- [
- "f64"
- "NEG_INFINITY"
- ]
- None
+ mkGenericPathExpr ("f64" :: "NEG_INFINITY" :: []) None
| NativeInt, (:? nativeint as x) ->
let expr = mkIsizeLitExpr (abs x |> string)
-
- if x < 0n then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0n)
| Int8, (:? int8 as x) ->
let expr = mkInt8LitExpr (abs x |> string)
-
- if x < 0y then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0y)
| Int16, (:? int16 as x) ->
let expr = mkInt16LitExpr (abs x |> string)
-
- if x < 0s then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0s)
| Int32, (:? int32 as x) ->
let expr = mkInt32LitExpr (abs x |> string)
-
- if x < 0 then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0)
| Int64, (:? int64 as x) ->
let expr = mkInt64LitExpr (abs x |> string)
-
- if x < 0 then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0L)
| Int128, x -> // (:? System.Int128 as x) ->
// let expr = mkInt128LitExpr (System.Int128.Abs(x) |> string)
- // if x < 0 then expr |> mkNegExpr else expr
+ // expr |> negateWhen (System.Int128.IsNegative(x))
let s = string x
let expr = mkInt128LitExpr (s.TrimStart('-'))
-
- if s.StartsWith("-", StringComparison.Ordinal) then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (s.StartsWith("-", StringComparison.Ordinal))
| UNativeInt, (:? unativeint as x) ->
mkUsizeLitExpr (x |> string)
| UInt8, (:? uint8 as x) -> mkUInt8LitExpr (x |> string)
@@ -2072,25 +1964,13 @@ module Util =
mkUInt128LitExpr (x |> string)
| Float16, (:? float32 as x) ->
let expr = mkFloat32LitExpr (abs x |> string)
-
- if x < 0.0f then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0.0f)
| Float32, (:? float32 as x) ->
let expr = mkFloat32LitExpr (abs x |> string)
-
- if x < 0.0f then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0.0f)
| Float64, (:? float as x) ->
let expr = mkFloat64LitExpr (abs x |> string)
-
- if x < 0.0 then
- expr |> mkNegExpr
- else
- expr
+ expr |> negateWhen (x < 0.0)
| Decimal, (:? decimal as x) ->
Replacements.makeDecimal com r t x |> transformExpr com ctx
| kind, x ->
@@ -2588,10 +2468,16 @@ module Util =
transformIdent com ctx range ident |> mkAddrOfExpr
| Fable.Unary(op, TransformExpr com ctx expr) ->
match op with
- | UnaryOperator.UnaryMinus -> mkNegExpr expr //?loc=range)
+ | UnaryOperator.UnaryMinus ->
+ match typ with
+ | Fable.Number((Int8 | Int16 | Int32 | Int64 | Int128 | NativeInt),
+ _) ->
+ // use wrapping negate to properly handle MinValue
+ mkMethodCallExpr "wrapping_neg" None expr []
+ | _ -> mkNegExpr expr
| UnaryOperator.UnaryPlus -> expr // no unary plus
- | UnaryOperator.UnaryNot -> mkNotExpr expr //?loc=range)
- | UnaryOperator.UnaryNotBitwise -> mkNotExpr expr //?loc=range)
+ | UnaryOperator.UnaryNot -> mkNotExpr expr // ?loc=range)
+ | UnaryOperator.UnaryNotBitwise -> mkNotExpr expr // ?loc=range)
| UnaryOperator.UnaryAddressOf -> expr |> mkAddrOfExpr
| Fable.Binary(op, leftExpr, rightExpr) ->
@@ -2639,7 +2525,7 @@ module Util =
left
right
]
- | _ -> mkBinaryExpr (mkBinOp kind) left right //?loc=range)
+ | _ -> mkBinaryExpr (mkBinOp kind) left right // ?loc=range)
| Fable.Logical(op,
TransformExpr com ctx left,
@@ -2649,7 +2535,7 @@ module Util =
| LogicalOperator.LogicalOr -> Rust.BinOpKind.Or
| LogicalOperator.LogicalAnd -> Rust.BinOpKind.And
- mkBinaryExpr (mkBinOp kind) left right //?loc=range)
+ mkBinaryExpr (mkBinOp kind) left right // ?loc=range)
let transformMacro
(com: IRustCompiler)
@@ -3049,7 +2935,7 @@ module Util =
mkAssignExpr left value
| _ ->
let left = getExpr range expr prop
- mkAssignExpr left value //?loc=range)
+ mkAssignExpr left value // ?loc=range)
| Fable.FieldSet(fieldName) ->
match fableExpr.Type with
| t when isInterface com t ->
@@ -3261,15 +3147,15 @@ module Util =
let thenExpr = transformLeaveContext com ctx None thenBody
match elseBody with
- | Fable.Value(Fable.UnitConstant, _) -> mkIfThenExpr guardExpr thenExpr //?loc=range)
+ | Fable.Value(Fable.UnitConstant, _) -> mkIfThenExpr guardExpr thenExpr // ?loc=range)
| _ ->
let elseExpr = transformLeaveContext com ctx None elseBody
- mkIfThenElseExpr guardExpr thenExpr elseExpr //?loc=range)
+ mkIfThenElseExpr guardExpr thenExpr elseExpr // ?loc=range)
let transformWhileLoop (com: IRustCompiler) ctx range guard body =
let guardExpr = transformExpr com ctx guard
let bodyExpr = com.TransformExpr(ctx, body)
- mkWhileExpr None guardExpr bodyExpr //?loc=range)
+ mkWhileExpr None guardExpr bodyExpr // ?loc=range)
let transformForLoop
(com: IRustCompiler)
@@ -3298,7 +3184,7 @@ module Util =
mkMethodCallExpr "rev" None rangeExpr []
- mkForLoopExpr None varPat rangeExpr bodyExpr //?loc=range)
+ mkForLoopExpr None varPat rangeExpr bodyExpr // ?loc=range)
let makeLocalLambda com ctx (args: Fable.Ident list) (body: Fable.Expr) =
let args = args |> discardUnitArg []
diff --git a/src/fable-library-py/fable_library/date.py b/src/fable-library-py/fable_library/date.py
index 5841b503ed..82571b8544 100644
--- a/src/fable-library-py/fable_library/date.py
+++ b/src/fable-library-py/fable_library/date.py
@@ -255,8 +255,12 @@ def min_value() -> datetime:
return datetime.min
-def op_addition(x: datetime, y: timedelta) -> datetime:
- return x + y
+def op_addition(x: datetime, y: TimeSpan) -> datetime:
+ return x + timedelta(microseconds=total_microseconds(y))
+
+
+def add(x: datetime, y: TimeSpan) -> datetime:
+ return op_addition(x, y)
def parse(string: str, detectUTC: bool = False) -> datetime:
@@ -300,6 +304,7 @@ def add_milliseconds(d: datetime, v: int) -> datetime:
__all__ = [
+ "add",
"op_subtraction",
"subtract",
"create",
@@ -325,5 +330,6 @@ def add_milliseconds(d: datetime, v: int) -> datetime:
"min_value",
"op_addition",
"parse",
+ "to_universal_time",
"try_parse",
]
diff --git a/src/fable-library-py/fable_library/map_util.py b/src/fable-library-py/fable_library/map_util.py
index e41209350b..275a97d1d7 100644
--- a/src/fable-library-py/fable_library/map_util.py
+++ b/src/fable-library-py/fable_library/map_util.py
@@ -1,7 +1,7 @@
from __future__ import annotations
import re
-from collections.abc import ByteString, Iterable, MutableSequence
+from collections.abc import Iterable
from enum import IntEnum
from re import Match
from typing import (
@@ -12,6 +12,7 @@
)
from .types import FSharpRef, Union
+from .util import Array
_K = TypeVar("_K")
@@ -124,7 +125,7 @@ def assign(key: str, case_rule: CaseRules, value: Any):
kv_pair = name if len(kv_pair.fields) == 0 else [name, *kv_pair.fields]
case_rule = defined_case_rule
- if isinstance(kv_pair, list | MutableSequence | ByteString):
+ if isinstance(kv_pair, Array):
length = len(kv_pair)
if length == 0:
fail(kv_pair)
diff --git a/tests/Integration/Compiler/Util/Compiler.fs b/tests/Integration/Compiler/Util/Compiler.fs
index bea40d0f67..26b1bc3453 100644
--- a/tests/Integration/Compiler/Util/Compiler.fs
+++ b/tests/Integration/Compiler/Util/Compiler.fs
@@ -1,13 +1,10 @@
namespace Fable.Tests.Compiler.Util
open System
-open FSharp.Compiler.CodeAnalysis
-open FSharp.Compiler.Diagnostics
-open FSharp.Compiler.SourceCodeServices
open Fable
-open Fable.Cli
open Fable.Cli.Main
open Fable.Transforms.State
+open Fable.Compiler.Util
module Compiler =
diff --git a/tests/Php/Fable.Tests.Php.fsproj b/tests/Php/Fable.Tests.Php.fsproj
index 4bdc89b056..fac29676f7 100644
--- a/tests/Php/Fable.Tests.Php.fsproj
+++ b/tests/Php/Fable.Tests.Php.fsproj
@@ -7,9 +7,9 @@
preview
-
-
-
+
+
+
runtime; build; native; contentfiles; analyzers; buildtransitive
all
diff --git a/tests/Python/Fable.Tests.Python.fsproj b/tests/Python/Fable.Tests.Python.fsproj
index cac5e1cb5a..b9aa5d8e77 100644
--- a/tests/Python/Fable.Tests.Python.fsproj
+++ b/tests/Python/Fable.Tests.Python.fsproj
@@ -9,9 +9,9 @@
Fable.Tests
-
-
-
+
+
+
runtime; build; native; contentfiles; analyzers; buildtransitive
all
diff --git a/tests/Python/TestTask.fs b/tests/Python/TestTask.fs
index a5a98d4277..d6db530ea9 100644
--- a/tests/Python/TestTask.fs
+++ b/tests/Python/TestTask.fs
@@ -13,10 +13,12 @@ let ``test Simple task translates without exception`` () =
let tsk = task { return () }
tsk.GetAwaiter().GetResult()
+[]
let ``test Simple task result translates without exception`` () =
let tsk = task { return () }
tsk.Result
+[]
let ``test Simple Task.FromResult translates without exception`` () =
let tsk = Task.FromResult 42
let result = tsk.Result
diff --git a/tests/Python/TestTimeSpan.fs b/tests/Python/TestTimeSpan.fs
index 48da9de4a6..cd3a3802d2 100644
--- a/tests/Python/TestTimeSpan.fs
+++ b/tests/Python/TestTimeSpan.fs
@@ -124,6 +124,19 @@ let ``test TimeSpan Addition works`` () =
test -2000. 0. -2000.
test 0. 0. 0.
+[]
+let ``test DateTime and TimeSpan Addition works`` () =
+ let test ms expected =
+ let dt = DateTime(2014,9,12,0,0,0,DateTimeKind.Utc)
+ let ts = TimeSpan.FromMilliseconds(ms)
+ let res1 = dt.Add(ts).ToUniversalTime()
+ let res2 = (dt + ts).ToUniversalTime()
+ equal true (res1 = res2)
+ equal expected res1
+
+ DateTime(2014,9,12,0,0,1,DateTimeKind.Utc) |> test 1000.
+ DateTime(2014,9,11,23,59,59,DateTimeKind.Utc) |> test -1000.
+
[]
let ``test TimeSpan implementation coherence`` () =
TimeSpan.FromTicks(1L).Ticks |> equal 1L
diff --git a/tests/Rust/Fable.Tests.Rust.fsproj b/tests/Rust/Fable.Tests.Rust.fsproj
index 164ccd4a6e..6760030bba 100644
--- a/tests/Rust/Fable.Tests.Rust.fsproj
+++ b/tests/Rust/Fable.Tests.Rust.fsproj
@@ -6,9 +6,9 @@
false
-
-
-
+
+
+
runtime; build; native; contentfiles; analyzers; buildtransitive
all
@@ -67,6 +67,7 @@
+
diff --git a/tests/Rust/tests/src/ArithmeticTests.fs b/tests/Rust/tests/src/ArithmeticTests.fs
index a85618da38..fc76876368 100644
--- a/tests/Rust/tests/src/ArithmeticTests.fs
+++ b/tests/Rust/tests/src/ArithmeticTests.fs
@@ -27,12 +27,12 @@ let ``Int32 literal addition is optimized`` () =
let ``Unary negation with negative literal values works`` () =
-negLiteral |> equal 345
-// []
-// let ``Unary negation with integer MinValue works`` () =
-// -(-128y) |> equal SByte.MinValue
-// -(-32768s) |> equal Int16.MinValue
-// -(-2147483648) |> equal Int32.MinValue
-// -(-9223372036854775808L) |> equal Int64.MinValue
+[]
+let ``Unary negation with integer MinValue works`` () =
+ -(-128y) |> equal SByte.MinValue
+ -(-32768s) |> equal Int16.MinValue
+ -(-2147483648) |> equal Int32.MinValue
+ -(-9223372036854775808L) |> equal Int64.MinValue
[]
let ``Infix subtract can be generated`` () =
diff --git a/tests/Rust/tests/src/TaskTests.fs b/tests/Rust/tests/src/TaskTests.fs
new file mode 100644
index 0000000000..07f4c17699
--- /dev/null
+++ b/tests/Rust/tests/src/TaskTests.fs
@@ -0,0 +1,137 @@
+module Fable.Tests.TaskTests
+
+open Util.Testing
+open System.Threading.Tasks
+
+type DisposableAction(f) =
+ interface System.IDisposable with
+ member _.Dispose() = f ()
+
+[]
+let ``Simple task translates without exception`` () =
+ let tsk = task { return () }
+ tsk.GetAwaiter().GetResult()
+
+[]
+let ``Simple task result translates without exception`` () =
+ let tsk = task { return () }
+ tsk.Result
+
+[]
+let ``Simple Task.FromResult translates without exception`` () =
+ let tsk = Task.FromResult 42
+ let result = tsk.Result
+ result |> equal 42
+
+[]
+let ``task while binding works correctly`` () =
+ let mutable result = 0
+ let tsk =
+ task {
+ while result < 10 do
+ result <- result + 1
+ }
+ tsk.GetAwaiter().GetResult()
+ result |> equal 10
+
+[]
+let ``Task for binding works correctly`` () =
+ let inputs = [| 1; 2; 3 |]
+ let mutable result = 0
+ let tsk =
+ task {
+ for inp in inputs do
+ result <- result + inp
+ }
+ tsk.GetAwaiter().GetResult()
+ result |> equal 6
+
+[]
+let ``Task exceptions are handled correctly`` () =
+ let mutable result = 0
+ let f shouldThrow =
+ let tsk =
+ task {
+ try
+ if shouldThrow then
+ failwith "boom!"
+ else
+ result <- 12
+ with
+ | _ -> result <- 10
+ }
+ tsk.GetAwaiter().GetResult()
+ result
+ f true + f false |> equal 22
+
+[]
+let ``Simple task is executed correctly`` () =
+ let mutable result = false
+ let x = task { return 99 }
+ task {
+ let! x = x
+ let y = 99
+ result <- x = y
+ }
+ |> (fun tsk -> tsk.GetAwaiter().GetResult())
+ result |> equal true
+
+[]
+let ``task use statements should dispose of resources when they go out of scope`` () =
+ let mutable isDisposed = false
+ let mutable step1ok = false
+ let mutable step2ok = false
+
+ let resource =
+ task { return new DisposableAction(fun () -> isDisposed <- true) }
+
+ task {
+ use! r = resource
+ step1ok <- not isDisposed
+ }
+ |> (fun tsk -> tsk.GetAwaiter().GetResult())
+
+ step2ok <- isDisposed
+ (step1ok && step2ok) |> equal true
+
+[]
+let ``Try ... with ... expressions inside async expressions work the same`` () =
+ let mutable result = ""
+ let throw () : unit = raise (exn "Boo!")
+ let append (x) = result <- result + x
+
+ let innerAsync () =
+ task {
+ append "b"
+ try
+ append "c"
+ throw ()
+ append "1"
+ with
+ | _ -> append "d"
+ append "e"
+ }
+
+ task {
+ append "a"
+ try
+ do! innerAsync ()
+ with
+ | _ -> append "2"
+ append "f"
+ }
+ |> (fun tsk -> tsk.GetAwaiter().GetResult())
+
+ result |> equal "abcdef"
+
+[]
+let ``TaskCompletionSource is executed correctly`` () =
+ let x =
+ task {
+ let tcs = TaskCompletionSource()
+ tcs.SetResult 42
+ return! tcs.Task
+ }
+ let result =
+ x |> (fun tsk -> tsk.GetAwaiter().GetResult())
+ result |> equal 42