├── version.config
├── fsxc
    ├── Program.fs
    ├── packages.config
    ├── AssemblyInfo.fs
    ├── fsxc.fsproj
    └── fsxc-legacy.fsproj
├── .git-blame-ignore-revs
├── test
    ├── test.fs
    ├── test.fsx
    ├── testRefLib.fsx
    ├── testRefLibOutsideCurrentFolder.fsx
    ├── testIfDef.fsx
    ├── testProcessConcurrencySample.fsx
    ├── testRefNugetLibNewFormat.fsx
    ├── testLegacyFx.fsx
    ├── testNonLegacyFx.fsx
    ├── testProcessSample.fsx
    ├── testRefNugetLibNewFormatWithShortVersion.fsx
    ├── testRefNugetLibNewFormatWithVersion.fsx
    ├── testRefNugetLib.fsx
    ├── testFsiCommandLineArgs.fsx
    ├── testProcessConcurrency.fsx
    └── testProcess.fsx
├── Fsdk.Tests
    ├── Program.fs
    ├── packages.config
    ├── Fsdk.Tests.fsproj
    ├── Tsv.fs
    ├── FSharpUtil.fs
    ├── Fsdk.Tests-legacy.fsproj
    └── AsyncExtensions.fs
├── Fsdk
    ├── packages.config
    ├── AssemblyInfo.fs
    ├── Fsdk.fsproj
    ├── Fsdk-legacy.fsproj
    ├── Taiga.fs
    ├── FSharpUtil.fs
    └── Git.fs
├── scripts
    ├── CI
    │   ├── install_mono.sh
    │   ├── install_dotnet_sdk_from_microsoft_deb_packages.sh
    │   └── install_mono_from_microsoft_deb_packages.sh
    ├── fsx.bat
    ├── snap_release.sh
    ├── build.sh
    ├── install.sh
    ├── snap_build.sh
    ├── launcher.sh
    ├── runUnitTests.fsx
    ├── .disabled-gitlab-ci.yml
    ├── snap_install_as_docker.sh
    ├── publish.fsx
    ├── make.fsx
    └── runTests.fsx
├── make.bat
├── config.toml
├── .gitignore
├── Makefile
├── Tools
    ├── fsi.bat
    ├── clean.fsx
    ├── replace.fsx
    ├── safeRun.fsx
    ├── bump.fsx
    ├── rename.fsx
    └── nugetPush.fsx
├── snap
    └── snapcraft.yaml
├── Directory.Build.props
├── LICENCE.txt
├── CONTRIBUTING.md
├── CommonBuildProps-legacy.proj
├── fsx
    ├── fsx.fsproj
    ├── fsx-legacy.fsproj
    └── Program.fs
├── configure.sh
├── fsx-legacy.sln
├── fsx.sln
├── compileFSharpScripts.fsx
├── .editorconfig
├── ReadMe.md
└── .github
    └── workflows
        └── CI.yml


/version.config:
--------------------------------------------------------------------------------
1 | BaseVersion=0.6.1
2 | 


--------------------------------------------------------------------------------
/fsxc/Program.fs:
--------------------------------------------------------------------------------
1 | open FSX.Compiler
2 | 
3 | [<EntryPoint>]
4 | let main argv =
5 |     Program.Main argv
6 | 


--------------------------------------------------------------------------------
/.git-blame-ignore-revs:
--------------------------------------------------------------------------------
1 | # Format F# files and scripts with fantomless v4.7.996
2 | 14deca289798ce31908a77344324558c4bdc047b
3 | 


--------------------------------------------------------------------------------
/test/test.fs:
--------------------------------------------------------------------------------
1 | namespace NS
2 | 
3 | module Inside =
4 |     let Foo() =
5 |         System.Console.WriteLine "hello from inside"
6 | 


--------------------------------------------------------------------------------
/test/test.fsx:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env fsx
2 | 
3 | #load "test.fs"
4 | NS.Inside.Foo()
5 | 
6 | System.Console.WriteLine("hello world")
7 | 


--------------------------------------------------------------------------------
/test/testRefLib.fsx:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env fsx
2 | 
3 | #r "test1.dll"
4 | NS.Inside.Foo()
5 | 
6 | System.Console.WriteLine("hello world")
7 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/Program.fs:
--------------------------------------------------------------------------------
1 | [<EntryPoint>]
2 | let main _argv =
3 |     failwith "Running the tests this way is not supported, use 'dotnet test'"
4 | 


--------------------------------------------------------------------------------
/Fsdk/packages.config:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="utf-8"?>
2 | <packages>
3 |   <package id="FSharp.Core" version="5.0.0.0" />
4 | </packages>


--------------------------------------------------------------------------------
/scripts/CI/install_mono.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 | set -euxo pipefail
3 | 
4 | DEBIAN_FRONTEND=noninteractive apt install -y fsharp
5 | mono --version
6 | 


--------------------------------------------------------------------------------
/test/testRefLibOutsideCurrentFolder.fsx:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env fsx
2 | 
3 | #r "lib/test2.dll"
4 | NS.Inside.Foo()
5 | 
6 | System.Console.WriteLine("hello world")
7 | 


--------------------------------------------------------------------------------
/fsxc/packages.config:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="utf-8"?>
2 | <packages>
3 |   <package id="FSharp.Core" version="4.5.4" targetFramework="net451" />
4 | </packages>


--------------------------------------------------------------------------------
/make.bat:
--------------------------------------------------------------------------------
1 | @ECHO OFF
2 | where /q dotnet
3 | IF ERRORLEVEL 1 (
4 |     Tools\fsi.bat scripts\make.fsx %*
5 | ) ELSE (
6 |     dotnet fsi scripts\make.fsx %*
7 | )
8 | 
9 | 


--------------------------------------------------------------------------------
/scripts/fsx.bat:
--------------------------------------------------------------------------------
1 | @ECHO OFF
2 | SET "FSXFSX=%ProgramW6432%\fsx\fsx.dll"
3 | 
4 | IF NOT EXIST "%FSXFSX%" (
5 |     ECHO "%FSXFSX% not found" && EXIT /b 1
6 | )
7 | 
8 | dotnet "%FSXFSX%" %*
9 | 


--------------------------------------------------------------------------------
/test/testIfDef.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | #if SOME_CONSTANT
 4 | printf "pre-hello1"
 5 | #else
 6 | printf "pre-hello2"
 7 | #endif
 8 | 
 9 | System.Console.WriteLine("hello world")
10 | 


--------------------------------------------------------------------------------
/config.toml:
--------------------------------------------------------------------------------
1 | # Required to run DinD
2 | # See https://docs.gitlab.com/runner/executors/docker.html#use-docker-in-docker-with-privileged-mode
3 | [[runners]]
4 |   executor = "docker"
5 |   [runners.docker]
6 |     privileged = true
7 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | bin/
 2 | obj/
 3 | .vs/
 4 | build.config
 5 | packages/
 6 | .nuget/
 7 | 
 8 | #snap creation:
 9 | staging/
10 | stage/
11 | snap/
12 | prime/
13 | parts/
14 | *.snap
15 | snapcraft.login
16 | 
17 | #macOS
18 | .DS_Store
19 | 
20 | #VSCode (Ionide?)
21 | .fake
22 | 


--------------------------------------------------------------------------------
/test/testProcessConcurrencySample.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | System.Console.WriteLine("foo")
 3 | System.Console.Out.Flush()
 4 | 
 5 | System.Console.Error.WriteLine("bar")
 6 | System.Console.Error.Flush()
 7 | 
 8 | System.Console.WriteLine("baz")
 9 | System.Console.Out.Flush()
10 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/packages.config:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="utf-8"?>
2 | <packages>
3 |   <package id="NUnit" version="2.6.4" targetFramework="net46" />
4 |   <package id="NUnitTestAdapter" version="2.1.1" targetFramework="net46" />
5 |   <package id="FSharp.Core" version="4.7.0" targetFramework="net461" />
6 | </packages>


--------------------------------------------------------------------------------
/test/testRefNugetLibNewFormat.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | open System
 4 | open System.IO
 5 | open System.Linq
 6 | 
 7 | #r "nuget: TickSpec"
 8 | 
 9 | let someProcedure() =
10 |     ()
11 | 
12 | let action: TickSpec.Action = TickSpec.Action someProcedure
13 | Console.WriteLine(action.GetType().FullName)
14 | 


--------------------------------------------------------------------------------
/test/testLegacyFx.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | #if LEGACY_FRAMEWORK
 4 | #r "test1.dll"
 5 | #else
 6 | #r "nonExistent.dll"
 7 | #endif
 8 | 
 9 | #if !LEGACY_FRAMEWORK
10 | #r "nonExistent.dll"
11 | #else
12 | #r "test1.dll"
13 | #endif
14 | 
15 | NS.Inside.Foo()
16 | 
17 | System.Console.WriteLine("hello world")
18 | 


--------------------------------------------------------------------------------
/test/testNonLegacyFx.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | #if !LEGACY_FRAMEWORK
 4 | #r "test1.dll"
 5 | #else
 6 | #r "nonExistent.dll"
 7 | #endif
 8 | 
 9 | #if LEGACY_FRAMEWORK
10 | #r "nonExistent.dll"
11 | #else
12 | #r "test1.dll"
13 | #endif
14 | 
15 | NS.Inside.Foo()
16 | 
17 | System.Console.WriteLine("hello world")
18 | 


--------------------------------------------------------------------------------
/test/testProcessSample.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | System.Console.WriteLine("foo")
 3 | System.Console.Out.Flush()
 4 | 
 5 | System.Console.Write("bar")
 6 | System.Console.Out.Flush()
 7 | System.Console.WriteLine System.String.Empty
 8 | System.Console.Out.Flush()
 9 | 
10 | System.Console.WriteLine("baz")
11 | System.Console.Out.Flush()
12 | 


--------------------------------------------------------------------------------
/test/testRefNugetLibNewFormatWithShortVersion.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | open System
 4 | open System.IO
 5 | open System.Linq
 6 | 
 7 | #r "nuget: TickSpec, 2.0.1"
 8 | 
 9 | let someProcedure() =
10 |     ()
11 | 
12 | let action: TickSpec.Action = TickSpec.Action someProcedure
13 | Console.WriteLine(action.GetType().FullName)
14 | 


--------------------------------------------------------------------------------
/test/testRefNugetLibNewFormatWithVersion.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | open System
 4 | open System.IO
 5 | open System.Linq
 6 | 
 7 | #r "nuget: TickSpec, Version=2.0.1"
 8 | 
 9 | let someProcedure() =
10 |     ()
11 | 
12 | let action: TickSpec.Action = TickSpec.Action someProcedure
13 | Console.WriteLine(action.GetType().FullName)
14 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | all:
 2 | 	./scripts/build.sh
 3 | 
 4 | release:
 5 | 	./scripts/build.sh /p:Configuration=Release
 6 | 
 7 | install: release
 8 | 	./scripts/install.sh
 9 | 
10 | reinstall:
11 | 	echo "'reinstall' target not supported yet in Unix, uninstall manually and use 'install' for now" >> /dev/stderr
12 | 	exit 1
13 | 
14 | check:
15 | 	./scripts/runTests.fsx
16 | 


--------------------------------------------------------------------------------
/scripts/snap_release.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | set -e
 3 | 
 4 | if [ -e snapcraft.login ]
 5 | then
 6 |     echo "snapcraft.login found, skipping log-in"
 7 | else
 8 |     snapcraft export-login snapcraft.login
 9 | fi
10 | snapcraft login --with snapcraft.login
11 | ./snap_build.sh
12 | 
13 | # we can only do 'edge' for now because the 'stable' channel might require stable grade
14 | snapcraft push *.snap --release=edge
15 | 
16 | 


--------------------------------------------------------------------------------
/scripts/build.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | set -e
 3 | 
 4 | if [ ! -f ./build.config ]; then
 5 |     echo "Please run ./configure.sh first" >&2
 6 |     exit 1
 7 | fi
 8 | source build.config
 9 | 
10 | if [[ ! $BuildTool == dotnet* ]]; then
11 |     mkdir -p .nuget/
12 |     curl -o .nuget/NuGet.exe https://dist.nuget.org/win-x86-commandline/v5.4.0/nuget.exe
13 |     mono .nuget/NuGet.exe restore $Solution
14 | fi
15 | 
16 | $BuildTool $Solution $1
17 | 


--------------------------------------------------------------------------------
/scripts/CI/install_dotnet_sdk_from_microsoft_deb_packages.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | set -e
 3 | 
 4 | # taken from https://docs.microsoft.com/en-gb/dotnet/core/install/linux-ubuntu#2004-
 5 | apt install -y wget
 6 | wget -q https://packages.microsoft.com/config/ubuntu/20.04/packages-microsoft-prod.deb
 7 | dpkg -i packages-microsoft-prod.deb
 8 | apt install -y apt-transport-https
 9 | apt update
10 | 
11 | DEBIAN_FRONTEND=noninteractive apt-get install -y dotnet-sdk-5.0
12 | 
13 | dotnet --version
14 | 


--------------------------------------------------------------------------------
/scripts/install.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | set -euxo
 3 | 
 4 | source build.config
 5 | 
 6 | FSX_INSTALL_DIR="$Prefix/lib/fsx"
 7 | BIN_INSTALL_DIR="$Prefix/bin"
 8 | 
 9 | mkdir -p $FSX_INSTALL_DIR
10 | mkdir -p $BIN_INSTALL_DIR
11 | 
12 | if [[ x"$Solution" == "xfsx.sln" ]]; then
13 |     cp -rfvp ./fsxc/bin/Release/net6.0/* $FSX_INSTALL_DIR
14 | else
15 |     cp -rfvp ./fsxc/bin/Release/* $FSX_INSTALL_DIR
16 | fi
17 | cp -v ./scripts/launcher.sh "$BIN_INSTALL_DIR/fsx"
18 | chmod ugo+x "$BIN_INSTALL_DIR/fsx"
19 | 


--------------------------------------------------------------------------------
/Tools/fsi.bat:
--------------------------------------------------------------------------------
 1 | @ECHO OFF
 2 | 
 3 | SET "VSWHERE=%ProgramFiles(x86)%\Microsoft Visual Studio\Installer\vswhere.exe"
 4 | SET "INSTALL_MSG=Please install .NET v6, or higher; or Visual Studio."
 5 | 
 6 | IF NOT EXIST "%VSWHERE%" (
 7 |     echo:
 8 |     echo Tool vswhere.exe not found.
 9 |     echo %INSTALL_MSG%
10 |     exit /b 1
11 | )
12 | 
13 | FOR /f "tokens=* delims=" %%A in ('"%VSWHERE%" -latest -requires Microsoft.VisualStudio.Component.FSharp -find **\fsi.exe') do set RUNNER=%%A
14 | 
15 | IF "%RUNNER%"=="" (
16 |     echo:
17 |     echo F# not found.
18 |     echo %INSTALL_MSG%
19 |     exit /b 1
20 | )
21 | 
22 | "%RUNNER%" --define:LEGACY_FRAMEWORK %*
23 | 


--------------------------------------------------------------------------------
/snap/snapcraft.yaml:
--------------------------------------------------------------------------------
 1 | name: fsx # you probably want to 'snapcraft register <name>'
 2 | base: core20 # the base snap is the execution environment for this snap
 3 | version: '0.1.0.1' # just for humans, typically '1.2+git' or '1.3.2'
 4 | summary: F# scripting tool # 79 char long summary
 5 | description: |
 6 |   FSX is the ideal tool for people that use F# for their scripting needs.
 7 | 
 8 | grade: devel # must be 'stable' to release into candidate/stable channels
 9 | confinement: classic # use 'strict' once you have the right plugs and slots
10 | 
11 | apps:
12 |   fsx:
13 |     command: bin/fsx
14 | 
15 | parts:
16 |   fsx:
17 |     plugin: dump
18 |     source: ./staging
19 | 
20 | 


--------------------------------------------------------------------------------
/test/testRefNugetLib.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | open System
 4 | open System.IO
 5 | open System.Linq
 6 | 
 7 | // with new dotnet (not legacy) we would use #r "nuget: NugetPkgName" so
 8 | // this test only applies to legacy
 9 | #if LEGACY_FRAMEWORK
10 | 
11 | #r "../packages/Microsoft.Build.16.11.0/lib/net472/Microsoft.Build.dll"
12 | open Microsoft.Build.Construction
13 | 
14 | let sol =
15 |     SolutionFile.Parse
16 |     <| Path.Combine(__SOURCE_DIRECTORY__, "..", "fsx-legacy.sln")
17 | 
18 | for (proj: string) in
19 |     (sol
20 |         .ProjectsInOrder
21 |         .Select(fun p -> p.ProjectName)
22 |         .ToList()) do
23 |     Console.WriteLine proj
24 | 
25 | #endif
26 | 
27 | Console.WriteLine "hello"
28 | 


--------------------------------------------------------------------------------
/scripts/CI/install_mono_from_microsoft_deb_packages.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | set -euxo pipefail
 3 | 
 4 | # Microsoft's APT repository for 20.04 is same as for 22.04
 5 | #source /etc/os-release
 6 | 
 7 | # required by apt-key
 8 | apt install -y gnupg2
 9 | # required by apt-update when pulling from mono-project.com
10 | apt install -y ca-certificates
11 | 
12 | # taken from http://www.mono-project.com/download/stable/#download-lin
13 | apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv-keys 3FA7E0328081BFF6A14DA29AA6A19B38D3D831EF
14 | echo "deb https://download.mono-project.com/repo/ubuntu stable-focal main" | tee /etc/apt/sources.list.d/mono-official-stable.list
15 | apt update
16 | 
17 | ./scripts/CI/install_mono.sh
18 | 


--------------------------------------------------------------------------------
/Directory.Build.props:
--------------------------------------------------------------------------------
 1 | <Project>
 2 |   <!-- TODO: check if we can use WarnOn instead of OtherFlags below:
 3 |        (see https://github.com/dotnet/fsharp/pull/10885 ) -->
 4 |   <PropertyGroup>
 5 |     <OtherFlags>$(OtherFlags) --warnon:0193</OtherFlags>
 6 |     <OtherFlags>$(OtherFlags) --warnon:1182</OtherFlags>
 7 |     <OtherFlags>$(OtherFlags) --warnon:3218</OtherFlags>
 8 | 
 9 |     <!-- not sure if this one below was already ON by default,
10 |          but it is so important that we add it just in case: -->
11 |     <OtherFlags>$(OtherFlags) --warnon:0020</OtherFlags>
12 |   </PropertyGroup>
13 |   <PropertyGroup Condition=" '$(Configuration)' != 'Debug' ">
14 |     <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
15 |   </PropertyGroup>
16 | </Project>
17 | 


--------------------------------------------------------------------------------
/test/testFsiCommandLineArgs.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | 
 3 | open System
 4 | 
 5 | let args = fsi.CommandLineArgs
 6 | 
 7 | if args.Length < 4 then
 8 |     Console.Error.WriteLine(
 9 |         sprintf "Failed: expected number of args 4, got %i" args.Length
10 |     )
11 | 
12 |     Environment.Exit 1
13 | 
14 | let expected = "?,one,2,three"
15 | let got = String.Join(",", args)
16 | 
17 | if args.[1] <> "one" then
18 |     Console.Error.WriteLine(
19 |         sprintf
20 |             "Failed: different 1st arg; expected '%s', got '%s'"
21 |             expected
22 |             got
23 |     )
24 | 
25 |     Environment.Exit 2
26 | 
27 | if args.[2] <> "2" then
28 |     Console.Error.WriteLine(
29 |         sprintf
30 |             "Failed: different 2nd arg; expected '%s', got '%s'"
31 |             expected
32 |             got
33 |     )
34 | 
35 |     Environment.Exit 3
36 | 
37 | if args.[3] <> "three" then
38 |     Console.Error.WriteLine(
39 |         sprintf
40 |             "Failed: different 3rd arg; expected '%s', got '%s'"
41 |             expected
42 |             got
43 |     )
44 | 
45 |     Environment.Exit 4
46 | 
47 | Console.WriteLine "Success"
48 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/Fsdk.Tests.fsproj:
--------------------------------------------------------------------------------
 1 | <Project Sdk="Microsoft.NET.Sdk">
 2 | 
 3 |   <PropertyGroup>
 4 |     <TargetFramework>net6.0</TargetFramework>
 5 | 
 6 |     <IsPackable>false</IsPackable>
 7 |     <GenerateProgramFile>false</GenerateProgramFile>
 8 |   </PropertyGroup>
 9 | 
10 |   <ItemGroup>
11 |     <Compile Include="FSharpUtil.fs" />
12 |     <Compile Include="AsyncExtensions.fs" />
13 |     <Compile Include="AsyncCancellation.fs" />
14 |     <Compile Include="Tsv.fs" />
15 |     <Compile Include="Program.fs" />
16 |   </ItemGroup>
17 | 
18 |   <ItemGroup>
19 |     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.3.2" />
20 |     <PackageReference Include="NUnit" Version="3.13.3" />
21 |     <PackageReference Include="NUnit3TestAdapter" Version="4.2.1" />
22 |     <PackageReference Include="NUnit.Analyzers" Version="3.3.0" />
23 |     <PackageReference Include="coverlet.collector" Version="3.1.2" />
24 |   </ItemGroup>
25 | 
26 |   <ItemGroup>
27 |     <ProjectReference Include="..\Fsdk\Fsdk.fsproj" />
28 |   </ItemGroup>
29 | 
30 |   <ItemGroup>
31 |     <PackageReference Update="FSharp.Core" Version="4.7.0" />
32 |   </ItemGroup>
33 | 
34 | </Project>
35 | 


--------------------------------------------------------------------------------
/test/testProcessConcurrency.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | open System
 3 | open System.IO
 4 | 
 5 | #r "System.Configuration"
 6 | open System.Configuration
 7 | 
 8 | #load "../Fsdk/Misc.fs"
 9 | #load "../Fsdk/Process.fs"
10 | 
11 | open Fsdk
12 | open Fsdk.Process
13 | 
14 | let mutable retryCount = 0
15 | 
16 | while (retryCount < 20) do //this is a stress test
17 |     let procResult =
18 |         Process.Execute(
19 |             {
20 |                 Command = "fsharpi"
21 |                 Arguments = "test/testProcessConcurrencySample.fsx"
22 |             },
23 |             Echo.Off
24 |         )
25 | 
26 |     let actual =
27 |         (procResult
28 |             .UnwrapDefault()
29 |             .Replace(Environment.NewLine, "-"))
30 | 
31 |     let expected = "foo-bar-baz-"
32 | 
33 |     if (actual <> expected) then
34 |         Console.Error.WriteLine(
35 |             sprintf
36 |                 "Stress test failed, got `%s`, should have been `%s`"
37 |                 actual
38 |                 expected
39 |         )
40 | 
41 |         Environment.Exit 1
42 | 
43 |     retryCount <- retryCount + 1
44 | 
45 | Console.WriteLine "Success"
46 | Environment.Exit 0
47 | 


--------------------------------------------------------------------------------
/LICENCE.txt:
--------------------------------------------------------------------------------
 1 | The MIT License
 2 | 
 3 | Copyright (c) 2016-2023 Andres G. Aragoneses
 4 | Copyright (c) 2019 Diginex Ltd (www.diginex.com)
 5 | Copyright (c) 2016-2017 Gatecoin Ltd
 6 | 
 7 | Permission is hereby granted, free of charge, to any person obtaining a copy
 8 | of this software and associated documentation files (the "Software"), to deal
 9 | in the Software without restriction, including without limitation the rights
10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
11 | copies of the Software, and to permit persons to whom the Software is
12 | furnished to do so, subject to the following conditions:
13 | 
14 | The above copyright notice and this permission notice shall be included in
15 | all copies or substantial portions of the Software.
16 | 
17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
23 | THE SOFTWARE.
24 | 


--------------------------------------------------------------------------------
/scripts/snap_build.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | set -euxo pipefail
 3 | 
 4 | # Update system
 5 | apt update -y
 6 | 
 7 | # Install dependencies
 8 | apt install lsb-release docker.io -y
 9 | 
10 | # Install snap and snapcraft
11 | ./scripts/snap_install_as_docker.sh
12 | 
13 | # Build repo from source inside snappy container
14 | docker exec snappy ./configure.sh --prefix=./staging
15 | docker exec snappy make
16 | docker exec snappy make install
17 | 
18 | # Install snapcraft and dependencies
19 | docker exec snappy snap version
20 | docker exec snappy snap install core20
21 | docker exec snappy snap install --classic --stable snapcraft
22 | docker exec snappy snapcraft --version
23 | 
24 | # Build snap package
25 | docker exec snappy snapcraft --destructive-mode
26 | 
27 | # Copy built files from container to host to get the .snap package
28 | #
29 | # Make sure to keep /. at the end of the source directory
30 | # This way docker will copy the directory contents
31 | # instead of the entire directory into the destination directoy.
32 | #
33 | # This method has to be used because `docker cp` does not support
34 | # wildcards (*) in directory paths.
35 | # The name of the .snap package depends on the version so it changes
36 | # and cannot be hardcoded. 
37 | docker cp snappy:/fsx/. $(pwd)
38 | 


--------------------------------------------------------------------------------
/CONTRIBUTING.md:
--------------------------------------------------------------------------------
 1 | It is assumed that by contributing to this repository (or any repository
 2 | under the [nblockchain github org](https://github.com/nblockchain/)) in the
 3 | form of PullRequests, you grant the intellectual property of your
 4 | contribution under the terms of the MIT licence. If you don't wish to
 5 | comply with this policy, you can keep a fork in your github account.
 6 | 
 7 | 
 8 | # F# Coding Style
 9 | 
10 | * For formatting/indentation, please use fantomless-tool (install it
11 | via `dotnet tool install -g fantomless-tool --version $version`, using
12 | the same $version we use, which you can find in our CI pipelines). In
13 | fact our CI checks that the formatting is the same as the one done by
14 | this tool, so we recommend you to install this in a git pre-commit hook;
15 | see how to do this here:
16 | https://github.com/nblockchain/fantomless/commit/138146e3e8fc7e8d9d8404ef9956ace3f529c127
17 | * For the rest of style not covered by fantomas, please read our
18 | [F# Coding Style](https://github.com/nblockchain/conventions/blob/master/FSharpStyleGuide.md).
19 | 
20 | 
21 | # Workflow guidelines
22 | 
23 | For reference on how we like commit messages to be formatted, and other
24 | recommendations, please read our
25 | [Workflow guidelines](https://github.com/nblockchain/conventions/blob/master/WorkflowGuidelines.md).
26 | We even have a CI step that checks for common mistakes in commit messages,
27 | based on a tool called 'commitlint'.
28 | 


--------------------------------------------------------------------------------
/CommonBuildProps-legacy.proj:
--------------------------------------------------------------------------------
 1 | <Project>
 2 |   <PropertyGroup>
 3 |     <MinimumVisualStudioVersion Condition="'$(MinimumVisualStudioVersion)' == ''">11</MinimumVisualStudioVersion>
 4 |   </PropertyGroup>
 5 |   <PropertyGroup Condition="'$(FSharpTargetsPath)' == '' OR (!(Exists('$(FSharpTargetsPath)')))">
 6 |     <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Common7\IDE\CommonExtensions\Microsoft\FSharp\Tools\Microsoft.FSharp.Targets</FSharpTargetsPath>
 7 |   </PropertyGroup>
 8 |   <PropertyGroup Condition="'$(FSharpTargetsPath)' == '' OR (!(Exists('$(FSharpTargetsPath)')))">
 9 |     <FSharpTargetsPath>$(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets</FSharpTargetsPath>
10 |   </PropertyGroup>
11 |   <PropertyGroup Condition="'$(FSharpTargetsPath)' == '' OR (!(Exists('$(FSharpTargetsPath)')))">
12 |     <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\4.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
13 |   </PropertyGroup>
14 |   <PropertyGroup Condition="'$(FSharpTargetsPath)' == '' OR (!(Exists('$(FSharpTargetsPath)')))">
15 |     <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.1\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
16 |   </PropertyGroup>
17 |   <PropertyGroup Condition="'$(FSharpTargetsPath)' == '' OR (!(Exists('$(FSharpTargetsPath)')))">
18 |     <FSharpTargetsPath>$(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets</FSharpTargetsPath>
19 |   </PropertyGroup>
20 | </Project>
21 | 


--------------------------------------------------------------------------------
/Fsdk/AssemblyInfo.fs:
--------------------------------------------------------------------------------
 1 | namespace Fsdk.AssemblyInfo
 2 | 
 3 | open System.Reflection
 4 | open System.Runtime.CompilerServices
 5 | open System.Runtime.InteropServices
 6 | 
 7 | // General Information about an assembly is controlled through the following
 8 | // set of attributes. Change these attribute values to modify the information
 9 | // associated with an assembly.
10 | [<assembly: AssemblyTitle("Fsdk")>]
11 | [<assembly: AssemblyDescription("")>]
12 | [<assembly: AssemblyConfiguration("")>]
13 | [<assembly: AssemblyCompany("")>]
14 | [<assembly: AssemblyProduct("Fsdk")>]
15 | [<assembly: AssemblyCopyright("Copyright © 2016-2019")>]
16 | [<assembly: AssemblyTrademark("")>]
17 | [<assembly: AssemblyCulture("")>]
18 | 
19 | // Setting ComVisible to false makes the types in this assembly not visible
20 | // to COM components.  If you need to access a type in this assembly from
21 | // COM, set the ComVisible attribute to true on that type.
22 | [<assembly: ComVisible(false)>]
23 | 
24 | // The following GUID is for the ID of the typelib if this project is exposed to COM
25 | [<assembly: Guid("4634f264-784e-42da-b5a1-fe72125deafc")>]
26 | 
27 | // Version information for an assembly consists of the following four values:
28 | //
29 | //       Major Version
30 | //       Minor Version
31 | //       Build Number
32 | //       Revision
33 | //
34 | // You can specify all the values or you can default the Build and Revision Numbers
35 | // by using the '*' as shown below:
36 | // [<assembly: AssemblyVersion("1.0.*")>]
37 | [<assembly: AssemblyVersion("0.1.0.1")>]
38 | [<assembly: AssemblyFileVersion("0.1.0.1")>]
39 | 
40 | do ()
41 | 


--------------------------------------------------------------------------------
/fsxc/AssemblyInfo.fs:
--------------------------------------------------------------------------------
 1 | namespace Fsx.Fsxc.AssemblyInfo
 2 | 
 3 | open System.Reflection
 4 | open System.Runtime.CompilerServices
 5 | open System.Runtime.InteropServices
 6 | 
 7 | // General Information about an assembly is controlled through the following
 8 | // set of attributes. Change these attribute values to modify the information
 9 | // associated with an assembly.
10 | [<assembly: AssemblyTitle("fsxc")>]
11 | [<assembly: AssemblyDescription("")>]
12 | [<assembly: AssemblyConfiguration("")>]
13 | [<assembly: AssemblyCompany("")>]
14 | [<assembly: AssemblyProduct("fsxc")>]
15 | [<assembly: AssemblyCopyright("Copyright © 2016-2019")>]
16 | [<assembly: AssemblyTrademark("")>]
17 | [<assembly: AssemblyCulture("")>]
18 | 
19 | // Setting ComVisible to false makes the types in this assembly not visible
20 | // to COM components.  If you need to access a type in this assembly from
21 | // COM, set the ComVisible attribute to true on that type.
22 | [<assembly: ComVisible(false)>]
23 | 
24 | // The following GUID is for the ID of the typelib if this project is exposed to COM
25 | [<assembly: Guid("56DA5F03-8F7F-44AB-B692-5A24DB134A8B")>]
26 | 
27 | // Version information for an assembly consists of the following four values:
28 | //
29 | //       Major Version
30 | //       Minor Version
31 | //       Build Number
32 | //       Revision
33 | //
34 | // You can specify all the values or you can default the Build and Revision Numbers
35 | // by using the '*' as shown below:
36 | // [<assembly: AssemblyVersion("1.0.*")>]
37 | [<assembly: AssemblyVersion("0.1.0.1")>]
38 | [<assembly: AssemblyFileVersion("0.1.0.1")>]
39 | 
40 | do ()
41 | 


--------------------------------------------------------------------------------
/Tools/clean.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env -S dotnet fsi
 2 | 
 3 | open System
 4 | open System.IO
 5 | 
 6 | #r "System.Configuration"
 7 | open System.Configuration
 8 | 
 9 | #load "../Fsdk/Misc.fs"
10 | open Fsdk
11 | 
12 | let args = Misc.FsxOnlyArguments()
13 | 
14 | if args.Length > 1 then
15 |     Console.Error.WriteLine
16 |         "Can only pass one argument: --force (for when deciding not to do a dry-run)"
17 | 
18 |     Environment.Exit 1
19 | 
20 | let dryRun =
21 |     if args.Length = 0 then
22 |         Console.WriteLine "No arguments detected, performing dry-run"
23 |         true
24 |     else if args.[0] <> "--force" then
25 |         Console.Error.WriteLine
26 |             "Can only pass one flag: --force (for when deciding not to do a dry-run)"
27 | 
28 |         Environment.Exit 2
29 |         failwith "Unreachable"
30 |     else
31 |         false
32 | 
33 | let currentDir = Directory.GetCurrentDirectory() |> DirectoryInfo
34 | 
35 | let rec CanBeDeleted(dir: DirectoryInfo) : bool =
36 |     match dir.Name with
37 |     | "packages" -> dir.Parent.Parent.FullName = currentDir.FullName
38 |     | "bin"
39 |     | "obj" -> dir.Parent.Parent.Name = "src"
40 |     | _ -> false
41 | 
42 | let rec Clean(dir: DirectoryInfo) =
43 |     let subDirs = dir.EnumerateDirectories()
44 | 
45 |     for subDir in subDirs do
46 |         if CanBeDeleted subDir then
47 |             if dryRun then
48 |                 Console.WriteLine(
49 |                     sprintf "Dir %s can be deleted" subDir.FullName
50 |                 )
51 |             else
52 |                 Console.WriteLine(sprintf "Deleting dir %s" subDir.FullName)
53 |                 subDir.Delete true
54 |         else
55 |             Clean subDir
56 | 
57 | Clean currentDir
58 | 


--------------------------------------------------------------------------------
/Tools/replace.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsharpi
 2 | 
 3 | open System
 4 | open System.IO
 5 | 
 6 | #r "System.Configuration"
 7 | open System.Configuration
 8 | 
 9 | #load "../Fsdk/Misc.fs"
10 | open Fsdk
11 | 
12 | let args = Misc.FsxOnlyArguments()
13 | 
14 | let errTooManyArgs =
15 |     "Can only pass two arguments, with optional flag: replace.fsx -f=a.b oldstring newstring"
16 | 
17 | let note =
18 |     "NOTE: by default, some kind of files/folders will be excluded, e.g.: .git, *.dll, *.png, ..."
19 | 
20 | if args.Length > 3 then
21 |     Console.Error.WriteLine errTooManyArgs
22 |     Console.WriteLine note
23 |     Environment.Exit 1
24 | elif args.Length < 2 then
25 |     Console.Error.WriteLine
26 |         "Need to pass two arguments: replace.fsx oldstring newstring"
27 | 
28 |     Console.WriteLine note
29 |     Environment.Exit 1
30 | 
31 | let firstArg = args.[0]
32 | 
33 | let particularFile =
34 |     if firstArg.StartsWith "--file=" || firstArg.StartsWith "-f=" then
35 |         let file = firstArg.Substring(firstArg.IndexOf("=") + 1) |> FileInfo
36 | 
37 |         if not file.Exists then
38 |             failwithf "File '%s' doesn't exist" file.FullName
39 | 
40 |         file |> Some
41 |     else
42 |         if args.Length = 3 then
43 |             Console.Error.WriteLine errTooManyArgs
44 |             Console.WriteLine note
45 |             Environment.Exit 1
46 |             failwith "Unreachable"
47 | 
48 |         None
49 | 
50 | match particularFile with
51 | | None ->
52 |     let startDir = DirectoryInfo(Directory.GetCurrentDirectory())
53 |     let oldString, newString = args.[0], args.[1]
54 |     Misc.ReplaceTextInDir startDir oldString newString
55 | | Some file ->
56 |     let oldString, newString = args.[1], args.[2]
57 |     Misc.ReplaceTextInFile file oldString newString
58 | 


--------------------------------------------------------------------------------
/scripts/launcher.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | set -e
 3 | 
 4 | RUNNER=mono
 5 | ASSEMBLY_EXTENSION=exe
 6 | if ! which dotnet >/dev/null 2>&1; then
 7 |     if ! which fsharpc >/dev/null 2>&1; then
 8 |         echo "Please install dotnet (or legacy 'fsharp' apt package)"
 9 |         exit 1
10 |     fi
11 | else
12 |     RUNNER=dotnet
13 |     ASSEMBLY_EXTENSION=dll
14 | fi
15 | 
16 | if [ $# -lt 1 ]; then
17 |     echo "At least one argument expected"
18 |     exit 1
19 | fi
20 | 
21 | DIR_OF_THIS_SCRIPT=$(cd `dirname $0` && pwd)
22 | FSXC_PATH="$DIR_OF_THIS_SCRIPT/../lib/fsx/fsxc.dll"
23 | if ! [ -e $FSXC_PATH ]; then
24 |     FSXC_PATH="$DIR_OF_THIS_SCRIPT/../lib/fsx/fsxc.exe"
25 | fi
26 | 
27 | FIRST_ARGS=""
28 | FSX_SCRIPT=""
29 | REST_ARGS=""
30 | while [ $# -gt 0 ];
31 | do
32 |     ARG=$1
33 |     # FIXME: edge case: arg is simply "fsx", then below would think it had the
34 |     #        .fsx extension
35 |     EXTENSION="${ARG##*.}"
36 | 
37 |     if [ -z "$FSX_SCRIPT" ]; then
38 |         FIRST_ARGS="$FIRST_ARGS $ARG"
39 |     fi
40 |     shift
41 |     if [ $EXTENSION = fsx ]; then
42 |         FSX_SCRIPT=$ARG
43 |         REST_ARGS=$@
44 |     fi
45 | done
46 | 
47 | $RUNNER $FSXC_PATH $FIRST_ARGS
48 | 
49 | # if user didn't pass a .fsx script
50 | if [ -z "$FSX_SCRIPT" ]; then
51 |     # either a) fsxc already errored w/ exitCode<>0 <- but if that was the case, `set -e` would cause prev call to abort this script, so it'd not reach here
52 |     # or b) user gave valid flag that exited with exitCode=0 even without .fsx (e.g. `--help`) <- this case here, so let's exit:
53 |     exit 0
54 | fi
55 | 
56 | TARGET_DIR=$(dirname -- "$FSX_SCRIPT")
57 | TARGET_FILE=$(basename -- "$FSX_SCRIPT")
58 | TARGET_FILE_PATH="$TARGET_DIR/bin/$TARGET_FILE.$ASSEMBLY_EXTENSION"
59 | 
60 | exec $RUNNER $TARGET_FILE_PATH $REST_ARGS
61 | 


--------------------------------------------------------------------------------
/Fsdk/Fsdk.fsproj:
--------------------------------------------------------------------------------
 1 | <Project Sdk="Microsoft.NET.Sdk">
 2 | 
 3 |   <PropertyGroup>
 4 |     <TargetFramework>netstandard2.0</TargetFramework>
 5 | 
 6 |     <PackageOutputPath>./nupkg</PackageOutputPath>
 7 |     <PackageLicenseFile>LICENCE.txt</PackageLicenseFile>
 8 |     <RepositoryUrl>https://github.com/nblockchain/fsx.git</RepositoryUrl>
 9 |     <RepositoryType>git</RepositoryType>
10 |     <PackageReadmeFile>ReadMe.md</PackageReadmeFile>
11 |     <PackageId>Fsdk</PackageId>
12 |     <Authors>knocte,aarani,Bobface,msonawane</Authors>
13 |     <Copyright>
14 |         Copyright (c) 2016-2023 Andres G. Aragoneses
15 |         Copyright (c) 2019 Diginex Ltd
16 |         Copyright (c) 2016-2017 Gatecoin Ltd
17 |     </Copyright>
18 |     <PackageTags>FSharp F# fsx</PackageTags>
19 |   </PropertyGroup>
20 | 
21 |   <ItemGroup>
22 |     <Compile Remove="Taiga.fs" />
23 |   </ItemGroup>
24 |   <ItemGroup>
25 |     <Compile Include="FSharpUtil.fs" />
26 |     <Compile Include="Misc.fs" />
27 |     <Compile Include="Process.fs" />
28 |     <Compile Include="Git.fs" />
29 |     <Compile Include="Unix.fs" />
30 |     <Compile Include="Network.fs" />
31 |   </ItemGroup>
32 | 
33 |   <ItemGroup>
34 |     <Content
35 |       Include="..\LICENCE.txt"
36 |       Link="LICENCE.txt"
37 |       Pack="true"
38 |       PackagePath="LICENCE.txt"
39 |       />
40 | 
41 |     <Content
42 |       Include="..\ReadMe.md"
43 |       Link="ReadMe.md"
44 |       Pack="true"
45 |       PackagePath="ReadMe.md"
46 |       />
47 |   </ItemGroup>
48 | 
49 |   <ItemGroup>
50 |     <PackageReference Include="System.Xml.XDocument" Version="4.3.0">
51 |       <GeneratePathProperty></GeneratePathProperty>
52 |     </PackageReference>
53 |   </ItemGroup>
54 |   <ItemGroup>
55 |     <PackageReference Update="FSharp.Core" Version="4.7.0" />
56 |   </ItemGroup>
57 | </Project>
58 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/Tsv.fs:
--------------------------------------------------------------------------------
 1 | namespace Fsdk.Tests
 2 | 
 3 | open System
 4 | 
 5 | open NUnit.Framework
 6 | 
 7 | open Fsdk
 8 | 
 9 | [<TestFixture>]
10 | type Tsv() =
11 |     [<Test>]
12 |     member __.TestSymmetricTsvSimple() : unit =
13 |         let simpleTsv = "A:\t1\nB:\t2"
14 |         let map = Misc.TsvParse simpleTsv
15 | 
16 |         Assert.AreEqual(
17 |             map.Count,
18 |             2,
19 |             sprintf "Should have count 2 but had %i" map.Count
20 |         )
21 | 
22 |         Assert.AreEqual(map.Item "A:", "1", "A should map to 1")
23 | 
24 |     [<Test>]
25 |     member __.TestTsvAsymmetricVertical() : unit =
26 |         let simpleTsv = "A:\t1\nB:\t2\nC:\t3"
27 |         let map = Misc.TsvParse simpleTsv
28 | 
29 |         Assert.AreEqual(
30 |             map.Count,
31 |             3,
32 |             sprintf "Vertical test: Should have count 3 but had %i" map.Count
33 |         )
34 | 
35 |         Assert.AreEqual(map.Item "C:", "3", "Vertical test: C should map to 3")
36 | 
37 |     [<Test>]
38 |     member __.TestTsvAsymmetricHorizontal() : unit =
39 |         let simpleTsv = "A\tB\tC\n1\t2\t3"
40 |         let map = Misc.TsvParse simpleTsv
41 | 
42 |         Assert.AreEqual(
43 |             map.Count,
44 |             3,
45 |             sprintf "Horizontal test: Should have count 3 but had %i" map.Count
46 |         )
47 | 
48 |         Assert.AreEqual(map.Item "C", "3", "Horizontal test: C should map to 3")
49 | 
50 |     [<Test>]
51 |     member __.TestTsvHoles() : unit =
52 |         let simpleTsv = "A\tB\tC\n1\t\t3"
53 |         let map = Misc.TsvParse simpleTsv
54 | 
55 |         Assert.AreEqual(
56 |             map.Count,
57 |             3,
58 |             sprintf "Holes test: Should have count 3 but had %i" map.Count
59 |         )
60 | 
61 |         Assert.AreEqual(
62 |             map.Item "B",
63 |             String.Empty,
64 |             "Holes test: B should map to String.Empty"
65 |         )
66 | 


--------------------------------------------------------------------------------
/fsxc/fsxc.fsproj:
--------------------------------------------------------------------------------
 1 | <Project Sdk="Microsoft.NET.Sdk">
 2 | 
 3 |   <PropertyGroup>
 4 |     <OutputType>Exe</OutputType>
 5 |     <TargetFramework>net6.0</TargetFramework>
 6 | 
 7 |     <PackAsTool>true</PackAsTool>
 8 |     <ToolCommandName>fsxc</ToolCommandName>
 9 |     <PackageOutputPath>./nupkg</PackageOutputPath>
10 |     <PackageLicenseFile>LICENCE.txt</PackageLicenseFile>
11 |     <RepositoryUrl>https://github.com/nblockchain/fsx.git</RepositoryUrl> 
12 |     <RepositoryType>git</RepositoryType>
13 |     <PackageReadmeFile>ReadMe.md</PackageReadmeFile>
14 |     <PackageId>fsxc</PackageId>
15 |     <Authors>knocte,aarani,Bobface,msonawane</Authors>
16 |     <Copyright>
17 |         Copyright (c) 2016-2023 Andres G. Aragoneses
18 |         Copyright (c) 2019 Diginex Ltd
19 |         Copyright (c) 2016-2017 Gatecoin Ltd
20 |     </Copyright>
21 |     <PackageTags>FSharp F# fsx</PackageTags>
22 |     
23 |   </PropertyGroup>
24 | 
25 |   <ItemGroup>
26 |     <Compile Include="..\Fsdk\Misc.fs">
27 |       <Link>Fsdk\Misc.fs</Link>
28 |     </Compile>
29 |     <Compile Include="..\Fsdk\Process.fs">
30 |       <Link>Fsdk\Process.fs</Link>
31 |     </Compile>
32 |     <Compile Include="..\Fsdk\Git.fs">
33 |       <Link>Fsdk\Git.fs</Link>
34 |     </Compile>
35 |     <Compile Include="..\Fsdk\Network.fs">
36 |       <Link>Fsdk\Network.fs</Link>
37 |     </Compile>
38 |     <Compile Include="Fsxc.fs" />
39 |     <Compile Include="Program.fs" />
40 |   </ItemGroup>
41 | 
42 |   <ItemGroup>
43 |     <Folder Include="..\Fsdk\" />
44 |   </ItemGroup>
45 | 
46 |   <ItemGroup>
47 |     <Content 
48 |       Include="..\LICENCE.txt" 
49 |       Link="LICENCE.txt" 
50 |       Pack="true" 
51 |       PackagePath="LICENCE.txt"/>
52 |     
53 |     <Content 
54 |       Include="..\ReadMe.md" 
55 |       Link="ReadMe.md" 
56 |       Pack="true" 
57 |       PackagePath="ReadMe.md"/>
58 |   </ItemGroup>
59 | 
60 |   <ItemGroup>
61 |     <PackageReference Update="FSharp.Core" Version="4.7.0" />
62 |   </ItemGroup>
63 | </Project>
64 | 


--------------------------------------------------------------------------------
/test/testProcess.fsx:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env fsx
 2 | open System
 3 | open System.IO
 4 | open System.Linq
 5 | 
 6 | #r "System.Configuration"
 7 | open System.Configuration
 8 | 
 9 | #load "../Fsdk/Misc.fs"
10 | #load "../Fsdk/Process.fs"
11 | 
12 | open Fsdk
13 | open Fsdk.Process
14 | 
15 | let sourceDir = DirectoryInfo __SOURCE_DIRECTORY__
16 | 
17 | let sample =
18 |     Path.Combine(sourceDir.FullName, "testProcessSample.fsx") |> FileInfo
19 | 
20 | let mutable retryCount = 0
21 | 
22 | let command =
23 | #if !LEGACY_FRAMEWORK
24 |     "dotnet"
25 | #else
26 |     if Misc.GuessPlatform() = Misc.Platform.Windows then
27 |         // HACK: we should call fsx here but then we would get this problem in
28 |         // the tests: error FS0193: The process cannot access the file 'D:\a\fsx\fsx\test\bin\FSharp.Core.dll' because it is being used by another process.
29 |         match Process.VsWhere "**\\fsi.exe" with
30 |         | None -> failwith "fsi.exe not found"
31 |         | Some fsiExe -> fsiExe
32 |     else
33 |         // FIXME: extract PREFIX from build.config instead of assuming default
34 |         "/usr/local/bin/fsx"
35 | #endif
36 | 
37 | while (retryCount < 20) do //this is a stress test
38 |     let procResult =
39 |         Process.Execute(
40 |             {
41 |                 Command = command
42 | #if !LEGACY_FRAMEWORK
43 |                 Arguments = sprintf "fsi %s" sample.FullName
44 | #else
45 |                 Arguments = sample.FullName
46 | #endif
47 |             },
48 |             Echo.Off
49 |         )
50 | 
51 |     let actual =
52 |         (procResult
53 |             .UnwrapDefault()
54 |             .Replace(Environment.NewLine, "-"))
55 | 
56 |     let expected = "foo-bar-baz-"
57 | 
58 |     if (actual <> expected) then
59 |         Console.Error.WriteLine(
60 |             sprintf
61 |                 "Stress test failed, got `%s`, should have been `%s`"
62 |                 actual
63 |                 expected
64 |         )
65 | 
66 |         Environment.Exit 1
67 | 
68 |     retryCount <- retryCount + 1
69 | 
70 | Console.WriteLine "Success"
71 | Environment.Exit 0
72 | 


--------------------------------------------------------------------------------
/fsx/fsx.fsproj:
--------------------------------------------------------------------------------
 1 | <Project Sdk="Microsoft.NET.Sdk">
 2 | 
 3 |   <PropertyGroup>
 4 |     <OutputType>Exe</OutputType>
 5 |     <TargetFramework>net6.0</TargetFramework>
 6 |     <GenerateRuntimeConfigDevFile>true</GenerateRuntimeConfigDevFile>
 7 | 
 8 |     <PackAsTool>true</PackAsTool>
 9 |     <ToolCommandName>fsx</ToolCommandName>
10 |     <PackageOutputPath>./nupkg</PackageOutputPath>
11 |     <PackageLicenseFile>LICENCE.txt</PackageLicenseFile>
12 |     <RepositoryUrl>https://github.com/nblockchain/fsx.git</RepositoryUrl>
13 |     <RepositoryType>git</RepositoryType>
14 |     <PackageReadmeFile>ReadMe.md</PackageReadmeFile>
15 |     <PackageId>fsx</PackageId>
16 |     <Authors>knocte,aarani,Bobface,msonawane,realmarv</Authors>
17 |     <Copyright>
18 |         Copyright (c) 2016-2023 Andres G. Aragoneses
19 |         Copyright (c) 2019 Diginex Ltd
20 |         Copyright (c) 2016-2017 Gatecoin Ltd
21 |     </Copyright>
22 |     <PackageTags>FSharp F# fsx</PackageTags>
23 | 
24 |   </PropertyGroup>
25 | 
26 |   <ItemGroup>
27 |     <Compile Include="..\Fsdk\Misc.fs">
28 |       <Link>..\Fsdk\Misc.fs</Link>
29 |     </Compile>
30 |     <Compile Include="..\Fsdk\Process.fs">
31 |       <Link>..\Fsdk\Process.fs</Link>
32 |     </Compile>
33 |     <Compile Include="..\Fsdk\Git.fs">
34 |       <Link>..\Fsdk\Git.fs</Link>
35 |     </Compile>
36 |     <Compile Include="..\Fsdk\Network.fs">
37 |       <Link>..\Fsdk\Network.fs</Link>
38 |     </Compile>
39 |     <Compile Include="..\fsxc\Fsxc.fs">
40 |       <Link>..\fsxc\Fsxc.fs</Link>
41 |     </Compile>
42 |     <Compile Include="Program.fs" />
43 |   </ItemGroup>
44 | 
45 |   <ItemGroup>
46 |     <Content
47 |       Include="..\LICENCE.txt"
48 |       Link="LICENCE.txt"
49 |       Pack="true"
50 |       PackagePath="LICENCE.txt"/>
51 | 
52 |     <Content
53 |       Include="..\ReadMe.md"
54 |       Link="ReadMe.md"
55 |       Pack="true"
56 |       PackagePath="ReadMe.md"/>
57 |   </ItemGroup>
58 | 
59 |   <ItemGroup>
60 |     <PackageReference Update="FSharp.Core" Version="4.7.0" />
61 |   </ItemGroup>
62 | 
63 | </Project>
64 | 


--------------------------------------------------------------------------------
/configure.sh:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | set -e
 3 | 
 4 | if ! which make >/dev/null 2>&1; then
 5 |     echo "checking for make... not found"
 6 |     echo "Error: please install 'make'" >> /dev/stderr
 7 |     exit 1
 8 | else
 9 |     echo "checking for make... found"
10 | fi
11 | 
12 | BUILDTOOL=invalid
13 | SOLUTION=invalid
14 | if ! which dotnet >/dev/null 2>&1; then
15 |     echo "checking for dotnet... not found"
16 | 
17 |     if ! which fsharpc >/dev/null 2>&1; then
18 |         echo "checking for F# compiler... not found"
19 |         echo "Error: please install 'dotnet' (or legacy 'fsharpc')" >> /dev/stderr
20 |         exit 1
21 |     else
22 |         echo "checking for F# compiler... found"
23 |     fi
24 | 
25 |     if ! which msbuild >/dev/null 2>&1; then
26 |         echo "checking for msbuild... not found"
27 | 
28 |         if ! which xbuild >/dev/null 2>&1; then
29 |             echo "checking for xbuild... not found"
30 |             echo "Error: please install 'dotnet' (or legacy 'msbuild' or 'xbuild')" >> /dev/stderr
31 |             exit 1
32 |         else
33 |             echo "checking for xbuild... found"
34 |             BUILDTOOL=xbuild
35 |             SOLUTION=fsx-legacy.sln
36 |         fi
37 |     else
38 |         echo "checking for msbuild... found"
39 |         BUILDTOOL=msbuild
40 |         SOLUTION=fsx-legacy.sln
41 |     fi
42 | 
43 |     # for downloading nuget.exe
44 |     if ! which curl >/dev/null 2>&1; then
45 |         echo "checking for curl... not found"
46 |         echo "Error: please install 'curl'" >> /dev/stderr
47 |         exit 1
48 |     else
49 |         echo "checking for curl... found"
50 |     fi
51 | 
52 | else
53 |     echo "checking for dotnet... found"
54 |     BUILDTOOL='"dotnet build"'
55 |     SOLUTION=fsx.sln
56 | fi
57 | 
58 | DESCRIPTION="tarball"
59 | if which git >/dev/null 2>&1; then
60 |     # https://stackoverflow.com/a/12142066/1623521
61 |     DESCRIPTION=`git rev-parse --abbrev-ref HEAD`
62 | fi
63 | 
64 | #default:
65 | PREFIX=/usr/local
66 | 
67 | for i in "$@"
68 | do
69 | case $i in
70 |     -p=*|--prefix=*)
71 |     PREFIX="${i#*=}"
72 | 
73 |     ;;
74 |     *)
75 |             # unknown option
76 |     ;;
77 | esac
78 | done
79 | 
80 | source version.config
81 | echo -e "BuildTool=$BUILDTOOL\nSolution=$SOLUTION\nPrefix=$PREFIX" > build.config
82 | 
83 | echo
84 | echo -e "\tConfiguration summary for fsx $Version ($DESCRIPTION)"
85 | echo
86 | echo -e "\t* Installation prefix: $PREFIX"
87 | echo
88 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/FSharpUtil.fs:
--------------------------------------------------------------------------------
 1 | namespace Fsdk.Tests
 2 | 
 3 | open System
 4 | open System.Threading.Tasks
 5 | 
 6 | open NUnit.Framework
 7 | 
 8 | open Fsdk
 9 | 
10 | type UnexpectedTaskCanceledException(message: string, innerException) =
11 |     inherit TaskCanceledException(message, innerException)
12 | 
13 | 
14 | [<TestFixture>]
15 | type FSharpUtilCoverage() =
16 | 
17 |     [<Test>]
18 |     member __.``find exception: basic test``() =
19 |         let innerEx = TaskCanceledException "bar"
20 |         let wrapperEx = Exception("foo", innerEx)
21 | 
22 |         let childFound =
23 |             FSharpUtil.FindException<TaskCanceledException> wrapperEx
24 | 
25 |         match childFound with
26 |         | None -> failwith "should find through inner classes"
27 |         | Some ex ->
28 |             Assert.That(Object.ReferenceEquals(ex, innerEx), Is.True)
29 |             Assert.That(Object.ReferenceEquals(ex.InnerException, null))
30 | 
31 |     [<Test>]
32 |     member __.``find exception: it works with inherited classes (UnexpectedTaskCanceledException is child of TaskCanceledException)``
33 |         ()
34 |         =
35 |         let innerEx = TaskCanceledException "bar"
36 |         let inheritedEx = UnexpectedTaskCanceledException("foo", innerEx)
37 | 
38 |         let parentFound =
39 |             FSharpUtil.FindException<TaskCanceledException> inheritedEx
40 | 
41 |         match parentFound with
42 |         | None -> failwith "should work with derived classes"
43 |         | Some ex ->
44 |             Assert.That(Object.ReferenceEquals(ex, inheritedEx), Is.True)
45 |             Assert.That(Object.ReferenceEquals(ex.InnerException, innerEx))
46 | 
47 |     [<Test>]
48 |     member __.``find exception: flattens (AggregateEx)``() =
49 |         let innerEx1 = TaskCanceledException "bar" :> Exception
50 |         let innerEx2 = UnexpectedTaskCanceledException("baz", null) :> Exception
51 |         let parent = AggregateException("foo", [| innerEx1; innerEx2 |])
52 | 
53 |         let sibling1Found =
54 |             FSharpUtil.FindException<TaskCanceledException> parent
55 | 
56 |         match sibling1Found with
57 |         | None -> failwith "should work"
58 |         | Some ex -> Assert.That(Object.ReferenceEquals(ex, innerEx1), Is.True)
59 | 
60 |         let sibling2Found =
61 |             FSharpUtil.FindException<UnexpectedTaskCanceledException> parent
62 | 
63 |         match sibling2Found with
64 |         | None -> failwith "should find sibling 2 too"
65 |         | Some ex -> Assert.That(Object.ReferenceEquals(ex, innerEx2), Is.True)
66 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/Fsdk.Tests-legacy.fsproj:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="utf-8"?>
 2 | <Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 3 |   <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
 4 |   <PropertyGroup>
 5 |     <SchemaVersion>2.0</SchemaVersion>
 6 |     <ProjectGuid>{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}</ProjectGuid>
 7 |     <OutputType>Library</OutputType>
 8 |     <RootNamespace>Fsdk.Tests</RootNamespace>
 9 |     <AssemblyName>Fsdk.Tests</AssemblyName>
10 |     <TargetFrameworkVersion>v4.7.1</TargetFrameworkVersion>
11 |     <TargetFSharpCoreVersion>4.7.0.0</TargetFSharpCoreVersion>
12 |     <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
13 |     <Name>Fsdk.Tests</Name>
14 |   </PropertyGroup>
15 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
16 |     <DebugSymbols>true</DebugSymbols>
17 |     <DebugType>full</DebugType>
18 |     <Optimize>false</Optimize>
19 |     <Tailcalls>false</Tailcalls>
20 |     <OutputPath>bin\Debug\</OutputPath>
21 |     <DefineConstants>DEBUG;TRACE</DefineConstants>
22 |     <WarningLevel>3</WarningLevel>
23 |     <DocumentationFile>bin\Debug\Fsdk.Tests.XML</DocumentationFile>
24 |   </PropertyGroup>
25 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
26 |     <DebugType>pdbonly</DebugType>
27 |     <Optimize>true</Optimize>
28 |     <Tailcalls>true</Tailcalls>
29 |     <OutputPath>bin\Release\</OutputPath>
30 |     <DefineConstants>TRACE</DefineConstants>
31 |     <WarningLevel>3</WarningLevel>
32 |     <DocumentationFile>bin\Release\Fsdk.Tests.XML</DocumentationFile>
33 |   </PropertyGroup>
34 |   <PropertyGroup>
35 |     <DefineConstants>$(DefineConstants);LEGACY_FRAMEWORK</DefineConstants>
36 |   </PropertyGroup>
37 |   <ItemGroup>
38 |     <Reference Include="mscorlib" />
39 |     <Reference Include="System" />
40 |     <Reference Include="System.Runtime" />
41 |     <Reference Include="FSharp.Core">
42 |       <HintPath>..\packages\FSharp.Core.4.7.0\lib\net45\FSharp.Core.dll</HintPath>
43 |     </Reference>
44 |     <Reference Include="nunit.framework">
45 |       <HintPath>..\packages\NUnit.2.6.4\lib\nunit.framework.dll</HintPath>
46 |     </Reference>
47 |   </ItemGroup>
48 |   <ItemGroup>
49 |     <Compile Include="FSharpUtil.fs" />
50 |     <Compile Include="AsyncExtensions.fs" />
51 |     <Compile Include="Tsv.fs" />
52 |   </ItemGroup>
53 |   <ItemGroup>
54 |     <ProjectReference Include="..\Fsdk\Fsdk-legacy.fsproj" />
55 |   </ItemGroup>
56 |   <Import Project="..\CommonBuildProps-legacy.proj" />
57 |   <Import Condition="'$(FSharpTargetsPath)' != ''" Project="$(FSharpTargetsPath)" />
58 |   <Target Name="BeforeBuild">
59 |     <Message Condition="'$(FSharpTargetsPath)' == ''" Importance="High" Text="F# SDK path was not found!" />
60 |   </Target>
61 |   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
62 |        Other similar extension points exist, see Microsoft.Common.targets.
63 |   <Target Name="BeforeBuild">
64 |   </Target>
65 |   <Target Name="AfterBuild">
66 |   </Target>
67 |   -->
68 | </Project>
69 | 


--------------------------------------------------------------------------------
/Fsdk/Fsdk-legacy.fsproj:
--------------------------------------------------------------------------------
 1 | <?xml version="1.0" encoding="utf-8"?>
 2 | <Project ToolsVersion="14.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 3 |   <Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
 4 |   <PropertyGroup>
 5 |     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
 6 |     <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
 7 |     <SchemaVersion>2.0</SchemaVersion>
 8 |     <ProjectGuid>4634f264-784e-42da-b5a1-fe72125deafc</ProjectGuid>
 9 |     <OutputType>Library</OutputType>
10 |     <RootNamespace>Fsdk</RootNamespace>
11 |     <AssemblyName>Fsdk</AssemblyName>
12 |     <TargetFrameworkVersion>v4.7.1</TargetFrameworkVersion>
13 |     <TargetFSharpCoreVersion>4.7.0.0</TargetFSharpCoreVersion>
14 |     <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
15 |     <Name>Fsdk</Name>
16 |     <TargetFrameworkProfile />
17 |   </PropertyGroup>
18 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
19 |     <DebugSymbols>true</DebugSymbols>
20 |     <DebugType>full</DebugType>
21 |     <Optimize>false</Optimize>
22 |     <Tailcalls>false</Tailcalls>
23 |     <OutputPath>bin\Debug\</OutputPath>
24 |     <DefineConstants>DEBUG;TRACE</DefineConstants>
25 |     <WarningLevel>3</WarningLevel>
26 |     <DocumentationFile>bin\Debug\Fsdk.XML</DocumentationFile>
27 |   </PropertyGroup>
28 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
29 |     <DebugType>pdbonly</DebugType>
30 |     <Optimize>true</Optimize>
31 |     <Tailcalls>true</Tailcalls>
32 |     <OutputPath>bin\Release\</OutputPath>
33 |     <DefineConstants>TRACE</DefineConstants>
34 |     <WarningLevel>3</WarningLevel>
35 |     <DocumentationFile>bin\Release\Fsdk.XML</DocumentationFile>
36 |   </PropertyGroup>
37 |   <PropertyGroup>
38 |     <DefineConstants>$(DefineConstants);LEGACY_FRAMEWORK</DefineConstants>
39 |   </PropertyGroup>
40 |   <ItemGroup>
41 |     <Reference Include="mscorlib" />
42 |     <Reference Include="FSharp.Core">
43 |       <HintPath>..\packages\FSharp.Core.4.7.0\lib\net45\FSharp.Core.dll</HintPath>
44 |     </Reference>
45 |     <Reference Include="System" />
46 |     <Reference Include="System.Configuration" />
47 |     <Reference Include="System.Core" />
48 |     <Reference Include="System.Numerics" />
49 |     <Reference Include="System.Web" />
50 |     <Reference Include="System.Web.Extensions" />
51 |   </ItemGroup>
52 |   <ItemGroup>
53 |     <Compile Include="AssemblyInfo.fs" />
54 |     <Compile Include="FSharpUtil.fs" />
55 |     <Compile Include="Misc.fs" />
56 |     <Compile Include="Process.fs" />
57 |     <Compile Include="Unix.fs" />
58 |     <Compile Include="Git.fs" />
59 |     <Compile Include="Network.fs" />
60 |     <Compile Include="Taiga.fs" />
61 |   </ItemGroup>
62 |   <Import Project="..\CommonBuildProps-legacy.proj" />
63 |   <Import Condition="'$(FSharpTargetsPath)' != ''" Project="$(FSharpTargetsPath)" />
64 |   <Target Name="BeforeBuild">
65 |     <Message Condition="'$(FSharpTargetsPath)' == ''" Importance="High" Text="F# SDK path was not found!" />
66 |   </Target>
67 |   <!-- To modify your build process, add your task inside one of the targets below and uncomment it. 
68 |        Other similar extension points exist, see Microsoft.Common.targets.
69 |   <Target Name="BeforeBuild">
70 |   </Target>
71 |   <Target Name="AfterBuild">
72 |   </Target>
73 |   -->
74 | </Project>
75 | 


--------------------------------------------------------------------------------
/fsx/fsx-legacy.fsproj:
--------------------------------------------------------------------------------
 1 | <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 2 |   <PropertyGroup>
 3 |     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
 4 |     <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
 5 |     <ProjectGuid>{14E47DE0-49B3-4B58-9627-8C3F10A21D24}</ProjectGuid>
 6 |     <UseStandardResourceNames>true</UseStandardResourceNames>
 7 |     <OutputType>Exe</OutputType>
 8 |     <RootNamespace>fsx</RootNamespace>
 9 |     <AssemblyName>fsx</AssemblyName>
10 |     <TargetFrameworkVersion>v4.7.1</TargetFrameworkVersion>
11 |   </PropertyGroup>
12 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
13 |     <DebugSymbols>true</DebugSymbols>
14 |     <Optimize>false</Optimize>
15 |     <OutputPath>bin\Debug</OutputPath>
16 |     <DefineConstants>DEBUG</DefineConstants>
17 |     <ErrorReport>prompt</ErrorReport>
18 |     <ExternalConsole>true</ExternalConsole>
19 |     <PlatformTarget></PlatformTarget>
20 |   </PropertyGroup>
21 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
22 |     <Optimize>true</Optimize>
23 |     <OutputPath>bin\Release</OutputPath>
24 |     <DefineConstants></DefineConstants>
25 |     <ErrorReport>prompt</ErrorReport>
26 |     <ExternalConsole>true</ExternalConsole>
27 |     <GenerateTailCalls>true</GenerateTailCalls>
28 |     <PlatformTarget></PlatformTarget>
29 |   </PropertyGroup>
30 |   <PropertyGroup>
31 |     <DefineConstants>$(DefineConstants);LEGACY_FRAMEWORK</DefineConstants>
32 |   </PropertyGroup>
33 |   <ItemGroup>
34 |     <Reference Include="mscorlib" />
35 |     <Reference Include="System" />
36 |     <Reference Include="System.Core" />
37 |     <Reference Include="System.Numerics" />
38 |     <Reference Include="FSharp.Core">
39 |       <HintPath>..\packages\FSharp.Core.4.5.4\lib\net45\FSharp.Core.dll</HintPath>
40 |     </Reference>
41 |     <Reference Include="System.Configuration" />
42 |   </ItemGroup>
43 | 
44 |   <ItemGroup>
45 |     <Compile Include="..\Fsdk\Misc.fs">
46 |       <Link>..\Fsdk\Misc.fs</Link>
47 |     </Compile>
48 |     <Compile Include="..\Fsdk\Process.fs">
49 |       <Link>..\Fsdk\Process.fs</Link>
50 |     </Compile>
51 |     <Compile Include="..\Fsdk\Git.fs">
52 |       <Link>..\Fsdk\Git.fs</Link>
53 |     </Compile>
54 |     <Compile Include="..\Fsdk\Network.fs">
55 |       <Link>..\Fsdk\Network.fs</Link>
56 |     </Compile>
57 |     <Compile Include="..\fsxc\Fsxc.fs">
58 |       <Link>..\fsxc\Fsxc.fs</Link>
59 |     </Compile>
60 |     <Compile Include="Program.fs" />
61 |   </ItemGroup>
62 | 
63 |   <Import Project="..\CommonBuildProps-legacy.proj" />
64 |   <Import Condition="'$(FSharpTargetsPath)' != ''" Project="$(FSharpTargetsPath)" />
65 |   <Target Name="BeforeBuild">
66 |     <Message Condition="'$(FSharpTargetsPath)' == ''" Importance="High" Text="F# SDK path was not found!" />
67 |   </Target>
68 |   <Target Name="AfterBuild">
69 |     <!-- NOTE: to simplify the build in Unix(Mac&Linux), we simply copy the system's FSharp.Core instead of
70 |                taking it from nuget. TODO: we should make this uniform to all platforms, maybe via dotnet restore -->
71 |     <Copy SourceFiles="/usr/lib/mono/fsharp/FSharp.Core.dll"
72 |           DestinationFolder="$(OutputPath)"
73 |           ContinueOnError="true"
74 |           Condition="Exists('/usr/lib/mono/fsharp/FSharp.Core.dll')"
75 |      />
76 |     <Copy SourceFiles="/Library/Frameworks/Mono.framework/Versions/6.12.0/lib/mono/fsharp/FSharp.Core.dll"
77 |           DestinationFolder="$(OutputPath)"
78 |           ContinueOnError="true"
79 |           Condition="Exists('/Library/Frameworks/Mono.framework/Versions/6.12.0/lib/mono/fsharp/FSharp.Core.dll')"
80 |      />
81 |   </Target>
82 | </Project>
83 | 


--------------------------------------------------------------------------------
/fsxc/fsxc-legacy.fsproj:
--------------------------------------------------------------------------------
 1 | <Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
 2 |   <PropertyGroup>
 3 |     <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
 4 |     <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
 5 |     <ProjectGuid>{56DA5F03-8F7F-44AB-B692-5A24DB134A8B}</ProjectGuid>
 6 |     <UseStandardResourceNames>true</UseStandardResourceNames>
 7 |     <OutputType>Exe</OutputType>
 8 |     <RootNamespace>fsxc</RootNamespace>
 9 |     <AssemblyName>fsxc</AssemblyName>
10 |     <TargetFrameworkVersion>v4.7.1</TargetFrameworkVersion>
11 |   </PropertyGroup>
12 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
13 |     <DebugSymbols>true</DebugSymbols>
14 |     <Optimize>false</Optimize>
15 |     <OutputPath>bin\Debug</OutputPath>
16 |     <DefineConstants>DEBUG</DefineConstants>
17 |     <ErrorReport>prompt</ErrorReport>
18 |     <ExternalConsole>true</ExternalConsole>
19 |     <PlatformTarget></PlatformTarget>
20 |   </PropertyGroup>
21 |   <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
22 |     <Optimize>true</Optimize>
23 |     <OutputPath>bin\Release</OutputPath>
24 |     <DefineConstants></DefineConstants>
25 |     <ErrorReport>prompt</ErrorReport>
26 |     <ExternalConsole>true</ExternalConsole>
27 |     <GenerateTailCalls>true</GenerateTailCalls>
28 |     <PlatformTarget></PlatformTarget>
29 |   </PropertyGroup>
30 |   <PropertyGroup>
31 |     <DefineConstants>$(DefineConstants);LEGACY_FRAMEWORK</DefineConstants>
32 |   </PropertyGroup>
33 |   <ItemGroup>
34 |     <Reference Include="mscorlib" />
35 |     <Reference Include="System" />
36 |     <Reference Include="System.Core" />
37 |     <Reference Include="System.Numerics" />
38 |     <Reference Include="FSharp.Core">
39 |       <HintPath>..\packages\FSharp.Core.4.5.4\lib\net45\FSharp.Core.dll</HintPath>
40 |     </Reference>
41 |     <Reference Include="System.Configuration" />
42 |   </ItemGroup>
43 |   <ItemGroup>
44 |     <Folder Include="Fsdk\" />
45 |   </ItemGroup>
46 |   <ItemGroup>
47 |     <Compile Include="AssemblyInfo.fs" />
48 |     <Compile Include="..\Fsdk\Misc.fs">
49 |       <Link>Fsdk\Misc.fs</Link>
50 |     </Compile>
51 |     <Compile Include="..\Fsdk\Process.fs">
52 |       <Link>Fsdk\Process.fs</Link>
53 |     </Compile>
54 |     <Compile Include="..\Fsdk\Git.fs">
55 |       <Link>Fsdk\Git.fs</Link>
56 |     </Compile>
57 |     <Compile Include="..\Fsdk\Network.fs">
58 |       <Link>Fsdk\Network.fs</Link>
59 |     </Compile>
60 |     <Compile Include="Fsxc.fs" />
61 |     <Compile Include="Program.fs" />
62 |     <None Include="packages.config" />
63 |   </ItemGroup>
64 |   <Import Project="..\CommonBuildProps-legacy.proj" />
65 |   <Import Condition="'$(FSharpTargetsPath)' != ''" Project="$(FSharpTargetsPath)" />
66 |   <Target Name="BeforeBuild">
67 |     <Message Condition="'$(FSharpTargetsPath)' == ''" Importance="High" Text="F# SDK path was not found!" />
68 |   </Target>
69 |   <Target Name="AfterBuild">
70 |     <!-- NOTE: to simplify the build in Unix(Mac&Linux), we simply copy the system's FSharp.Core instead of
71 |                taking it from nuget. TODO: we should make this uniform to all platforms, maybe via dotnet restore -->
72 |     <Copy SourceFiles="/usr/lib/mono/fsharp/FSharp.Core.dll"
73 |           DestinationFolder="$(OutputPath)"
74 |           ContinueOnError="true"
75 |           Condition="Exists('/usr/lib/mono/fsharp/FSharp.Core.dll')"
76 |      />
77 |     <Copy SourceFiles="/Library/Frameworks/Mono.framework/Versions/6.12.0/lib/mono/fsharp/FSharp.Core.dll"
78 |           DestinationFolder="$(OutputPath)"
79 |           ContinueOnError="true"
80 |           Condition="Exists('/Library/Frameworks/Mono.framework/Versions/6.12.0/lib/mono/fsharp/FSharp.Core.dll')"
81 |      />
82 |   </Target>
83 | </Project>
84 | 


--------------------------------------------------------------------------------
/scripts/runUnitTests.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env fsx
  2 | 
  3 | open System
  4 | open System.IO
  5 | open System.Net
  6 | open System.Linq
  7 | open System.Diagnostics
  8 | 
  9 | #if LEGACY_FRAMEWORK
 10 | #r "System.Configuration"
 11 | open System.Configuration
 12 | #endif
 13 | 
 14 | #load "../Fsdk/Misc.fs"
 15 | #load "../Fsdk/Process.fs"
 16 | #load "../Fsdk/Git.fs"
 17 | #load "../Fsdk/Network.fs"
 18 | 
 19 | open Fsdk
 20 | open Fsdk.Process
 21 | 
 22 | let ScriptsDir = __SOURCE_DIRECTORY__ |> DirectoryInfo
 23 | let RootDir = Path.Combine(ScriptsDir.FullName, "..") |> DirectoryInfo
 24 | let TestDir = Path.Combine(RootDir.FullName, "test") |> DirectoryInfo
 25 | let NugetDir = Path.Combine(RootDir.FullName, ".nuget") |> DirectoryInfo
 26 | let NugetExe = Path.Combine(NugetDir.FullName, "nuget.exe") |> FileInfo
 27 | let NugetPackages = Path.Combine(RootDir.FullName, "packages") |> DirectoryInfo
 28 | 
 29 | let NugetScriptsPackagesDir() =
 30 |     let dir = Path.Combine(NugetDir.FullName, "packages") |> DirectoryInfo
 31 | 
 32 |     if not dir.Exists then
 33 |         Directory.CreateDirectory dir.FullName |> ignore
 34 | 
 35 |     dir
 36 | 
 37 | let MakeCheckCommand(commandName: string) =
 38 |     if not(Process.CommandWorksInShell commandName) then
 39 |         Console.Error.WriteLine(
 40 |             sprintf "%s not found, please install it first" commandName
 41 |         )
 42 | 
 43 |         Environment.Exit 1
 44 | 
 45 | let RunUnitTests() =
 46 |     Console.WriteLine "Running unit tests...\n"
 47 | 
 48 |     let testProjectName = "Fsdk.Tests"
 49 | #if !LEGACY_FRAMEWORK
 50 |     let testTarget =
 51 |         Path.Combine(
 52 |             RootDir.FullName,
 53 |             testProjectName,
 54 |             testProjectName + ".fsproj"
 55 |         )
 56 |         |> FileInfo
 57 | #else
 58 |     // so that we get file names in stack traces
 59 |     Environment.SetEnvironmentVariable("MONO_ENV_OPTIONS", "--debug")
 60 | 
 61 |     let testTargetDebug =
 62 |         Path.Combine(
 63 |             RootDir.FullName,
 64 |             testProjectName,
 65 |             "bin",
 66 |             "Debug",
 67 |             testProjectName + ".dll"
 68 |         )
 69 |         |> FileInfo
 70 | 
 71 |     let testTargetRelease =
 72 |         Path.Combine(
 73 |             RootDir.FullName,
 74 |             testProjectName,
 75 |             "bin",
 76 |             "Release",
 77 |             testProjectName + ".dll"
 78 |         )
 79 |         |> FileInfo
 80 | 
 81 |     let testTarget =
 82 |         if testTargetDebug.Exists then
 83 |             testTargetDebug
 84 |         else
 85 |             testTargetRelease
 86 | 
 87 |     if not testTarget.Exists then
 88 |         failwithf "File not found: %s" testTarget.FullName
 89 | #endif
 90 | 
 91 | 
 92 |     let runnerCommand =
 93 | #if !LEGACY_FRAMEWORK
 94 |         {
 95 |             Command = "dotnet"
 96 |             Arguments = "test " + testTarget.FullName
 97 |         }
 98 | #else
 99 |         match Misc.GuessPlatform() with
100 |         | Misc.Platform.Linux ->
101 |             let nunitCommand = "nunit-console"
102 |             MakeCheckCommand nunitCommand
103 | 
104 |             {
105 |                 Command = nunitCommand
106 |                 Arguments = testTarget.FullName
107 |             }
108 |         | _ ->
109 |             let nunitVersion = "2.7.1"
110 |             let pkgOutputDir = NugetScriptsPackagesDir()
111 | 
112 |             Network.InstallNugetPackage
113 |                 NugetExe
114 |                 pkgOutputDir
115 |                 "NUnit.Runners"
116 |                 (Some nunitVersion)
117 |                 Echo.All
118 |             |> ignore
119 | 
120 |             {
121 |                 Command =
122 |                     Path.Combine(
123 |                         NugetScriptsPackagesDir().FullName,
124 |                         sprintf "NUnit.Runners.%s" nunitVersion,
125 |                         "tools",
126 |                         "nunit-console.exe"
127 |                     )
128 |                 Arguments = testTarget.FullName
129 |             }
130 | #endif
131 | 
132 |     Process
133 |         .Execute(runnerCommand, Echo.All)
134 |         .UnwrapDefault()
135 |     |> ignore
136 | 
137 | RunUnitTests()
138 | 


--------------------------------------------------------------------------------
/scripts/.disabled-gitlab-ci.yml:
--------------------------------------------------------------------------------
  1 | before_script:
  2 |   - apt update -qq
  3 |   - apt install -y git make curl
  4 | 
  5 | stages:
  6 |   - buildAndInstall
  7 |   - test
  8 |   - compileScripts
  9 |   - sanitycheck
 10 |   - package
 11 | 
 12 | build&install-oldLTS-stockmono:
 13 |   image: ubuntu:20.04
 14 |   stage: buildAndInstall
 15 |   script:
 16 |     - ./scripts/CI/install_mono.sh
 17 | 
 18 |     - ./configure.sh
 19 |     - make
 20 |     - make install
 21 | 
 22 | build&install-oldLTS-newmono:
 23 |   image: ubuntu:20.04
 24 |   stage: buildAndInstall
 25 |   script:
 26 |     - ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
 27 | 
 28 |     - ./configure.sh
 29 |     - make
 30 |     - make install
 31 | 
 32 | build&install-newLTS-stockmono:
 33 |   image: ubuntu:22.04
 34 |   stage: buildAndInstall
 35 |   script:
 36 |     - ./scripts/CI/install_mono.sh
 37 | 
 38 |     - ./configure.sh
 39 |     - make
 40 |     - make install
 41 | 
 42 | build&install-newLTS-newmono:
 43 |   image: ubuntu:22.04
 44 |   stage: buildAndInstall
 45 |   script:
 46 |     - ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
 47 | 
 48 |     - ./configure.sh
 49 |     - make
 50 |     - make install
 51 | 
 52 | buildScripts-oldLTS-stockmono:
 53 |   image: ubuntu:20.04
 54 |   stage: compileScripts
 55 |   script:
 56 |     - ./scripts/CI/install_mono.sh
 57 | 
 58 |     - ./configure.sh && make install
 59 |     - make check
 60 |     - ./compileFSharpScripts.fsx
 61 | 
 62 | buildScripts-oldLTS-newmono:
 63 |   image: ubuntu:20.04
 64 |   stage: compileScripts
 65 |   script:
 66 |     - ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
 67 | 
 68 |     - ./configure.sh && make install
 69 |     - make check
 70 |     - ./compileFSharpScripts.fsx
 71 | 
 72 | buildScripts-newLTS-stockmono:
 73 |   image: ubuntu:22.04
 74 |   stage: compileScripts
 75 |   script:
 76 |     - ./scripts/CI/install_mono.sh
 77 | 
 78 |     - ./configure.sh && make install
 79 |     - make check
 80 |     - ./compileFSharpScripts.fsx
 81 | 
 82 | buildScripts-newLTS-newmono:
 83 |   image: ubuntu:22.04
 84 |   stage: compileScripts
 85 |   script:
 86 |     - ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
 87 | 
 88 |     - ./configure.sh && make install
 89 |     - make check
 90 |     - ./compileFSharpScripts.fsx
 91 | 
 92 | test-oldLTS-stockmono:
 93 |   image: ubuntu:20.04
 94 |   stage: test
 95 |   script:
 96 |     - ./scripts/CI/install_mono.sh
 97 | 
 98 |     - ./configure.sh && make install
 99 |     - make check
100 | 
101 | test-oldLTS-newmono:
102 |   image: ubuntu:20.04
103 |   stage: test
104 |   script:
105 |     - ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
106 | 
107 |     - ./configure.sh && make install
108 |     - make check
109 | 
110 | test-newLTS-stockmono:
111 |   image: ubuntu:22.04
112 |   stage: test
113 |   script:
114 |     - ./scripts/CI/install_mono.sh
115 | 
116 |     - ./configure.sh && make install
117 |     - make check
118 | 
119 | test-newLTS-newmono:
120 |   image: ubuntu:22.04
121 |   stage: test
122 |   script:
123 |     - ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
124 | 
125 |     - ./configure.sh && make install
126 |     - make check
127 | 
128 | style:
129 |   image: ubuntu:20.04
130 |   stage: sanitycheck
131 |   script:
132 |     - ./scripts/CI/install_dotnet_sdk_from_microsoft_deb_packages.sh
133 | 
134 |     # NOTE: maintain fantomless version below in sync with .github/workflows/CI.yml
135 |     - dotnet tool update --global fantomless-tool --version 4.7.996
136 |     - $HOME/.dotnet/tools/fantomless --recurse --check .
137 | 
138 | #
139 | # NOTE: snap package generation has been disabled because its Docker-in-Docker approach started failing
140 | # FIXME: report bug to Canonical's snap team
141 | #
142 | #package:
143 | #  image: ubuntu:20.04
144 | #  stage: package
145 | #
146 | #  variables:
147 | #    # Fixes:
148 | #    # "Cannot connect to the Docker daemon. Is the docker daemon running on this host?"
149 | #    DOCKER_HOST: tcp://docker:2375
150 | #  services:
151 | #    # To support docker-in-docker
152 | #    - docker:dind
153 | #
154 | #  script:
155 | #    - ./scripts/snap_build.sh
156 | #
157 | #  artifacts:
158 | #    paths:
159 | #      - fsx*.snap
160 | #    expire_in: 50days
161 | #
162 | 


--------------------------------------------------------------------------------
/scripts/snap_install_as_docker.sh:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env bash
  2 | set -euxo pipefail
  3 | 
  4 | CONTNAME=snappy
  5 | IMGNAME=snapd
  6 | RELEASE=20.04
  7 | 
  8 | SUDO=""
  9 | if [ -z "$(id -Gn|grep docker)" ] && [ "$(id -u)" != "0" ]; then
 10 |     SUDO="sudo"
 11 | fi
 12 | 
 13 | if [ "$(which docker)" = "/snap/bin/docker" ]; then
 14 |     export TMPDIR="$(readlink -f ~/snap/docker/current)"
 15 |     # we need to run the snap once to have $SNAP_USER_DATA created
 16 |     /snap/bin/docker >/dev/null 2>&1
 17 | fi
 18 | 
 19 | BUILDDIR=$(mktemp -d)
 20 | # Copy repo contents to build dir
 21 | $SUDO cp -r $(pwd) $BUILDDIR/fsx
 22 | 
 23 | usage() {
 24 |     echo "usage: $(basename $0) [options]"
 25 |     echo
 26 |     echo "  -c|--containername <name> (default: snappy)"
 27 |     echo "  -i|--imagename <name> (default: snapd)"
 28 |     rm_builddir
 29 | }
 30 | 
 31 | print_info() {
 32 |     echo
 33 |     echo "use: $SUDO docker exec -it $CONTNAME <command> ... to run a command inside this container"
 34 |     echo
 35 |     echo "to remove the container use: $SUDO docker rm -f $CONTNAME"
 36 |     echo "to remove the related image use: $SUDO docker rmi $IMGNAME"
 37 | }
 38 | 
 39 | clean_up() {
 40 |     sleep 1
 41 |     $SUDO docker rm -f $CONTNAME >/dev/null 2>&1 || true
 42 |     $SUDO docker rmi $IMGNAME >/dev/null 2>&1 || true
 43 |     $SUDO docker rmi $($SUDO docker images -f "dangling=true" -q) >/dev/null 2>&1 || true
 44 |     rm_builddir
 45 | }
 46 | 
 47 | rm_builddir() {
 48 |     rm -rf $BUILDDIR || true
 49 |     exit 0
 50 | }
 51 | 
 52 | trap clean_up 1 2 3 4 9 15
 53 | 
 54 | while [ $# -gt 0 ]; do
 55 |        case "$1" in
 56 |                -c|--containername)
 57 |                        [ -n "$2" ] && CONTNAME=$2 shift || usage
 58 |                        ;;
 59 |                -i|--imagename)
 60 |                        [ -n "$2" ] && IMGNAME=$2 shift || usage
 61 |                        ;;
 62 |                -h|--help)
 63 |                        usage
 64 |                        ;;
 65 |                *)
 66 |                        usage
 67 |                        ;;
 68 |        esac
 69 |        shift
 70 | done
 71 | 
 72 | if [ -n "$($SUDO docker ps -f name=$CONTNAME -q)" ]; then
 73 |     echo "Container $CONTNAME already running!"
 74 |     print_info
 75 |     rm_builddir
 76 | fi
 77 | 
 78 | if [ -z "$($SUDO docker images|grep $IMGNAME)" ]; then
 79 |     cat << EOF > $BUILDDIR/Dockerfile
 80 | FROM ubuntu:$RELEASE
 81 | ENV container docker
 82 | ENV PATH "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/snap/bin"
 83 | ENV LANG C.UTF-8
 84 | ENV LC_ALL C.UTF-8
 85 | RUN apt update &&\
 86 |  DEBIAN_FRONTEND=noninteractive\
 87 |  apt install -y fuse snapd snap-confine squashfuse sudo init lsb-release git docker.io fsharp build-essential pkg-config cli-common-dev mono-devel &&\
 88 |  apt clean &&\
 89 |  dpkg-divert --local --rename --add /sbin/udevadm &&\
 90 |  ln -s /bin/true /sbin/udevadm
 91 | RUN systemctl enable snapd
 92 | VOLUME ["/sys/fs/cgroup"]
 93 | STOPSIGNAL SIGRTMIN+3
 94 | RUN mkdir -p /fsx
 95 | WORKDIR /fsx
 96 | ADD fsx /fsx
 97 | CMD ["/sbin/init"]
 98 | EOF
 99 |     $SUDO docker build -t $IMGNAME --force-rm=true --rm=true $BUILDDIR || clean_up
100 | fi
101 | 
102 | # start the detached container
103 | $SUDO docker run \
104 |     --name=$CONTNAME \
105 |     -ti \
106 |     --tmpfs /run \
107 |     --tmpfs /run/lock \
108 |     --tmpfs /tmp \
109 |     --cap-add SYS_ADMIN \
110 |     --device=/dev/fuse \
111 |     --security-opt apparmor:unconfined \
112 |     --security-opt seccomp:unconfined \
113 |     -v /sys/fs/cgroup:/sys/fs/cgroup:ro \
114 |     -v /lib/modules:/lib/modules:ro \
115 |     -d $IMGNAME || clean_up
116 | 
117 | # wait for snapd to start
118 | TIMEOUT=100
119 | SLEEP=0.1
120 | echo -n "Waiting up to $(($TIMEOUT/10)) seconds for snapd startup "
121 | while [ "$($SUDO docker exec $CONTNAME sh -c 'systemctl status snapd.seeded >/dev/null 2>&1; echo $?')" != "0" ]; do
122 |     echo -n "."
123 |     sleep $SLEEP || clean_up
124 |     if [ "$TIMEOUT" -le "0" ]; then
125 |         echo " Timed out!"
126 |         clean_up
127 |     fi
128 |     TIMEOUT=$(($TIMEOUT-1))
129 | done
130 | echo " done"
131 | 
132 | $SUDO docker exec $CONTNAME snap install core --edge || clean_up
133 | echo "container $CONTNAME started ..."
134 | 
135 | print_info
136 | rm_builddir


--------------------------------------------------------------------------------
/Fsdk/Taiga.fs:
--------------------------------------------------------------------------------
  1 | namespace Fsdk
  2 | 
  3 | open System.Net
  4 | open System.Collections
  5 | open System.Collections.Generic
  6 | open System.Web.Script.Serialization
  7 | 
  8 | module Taiga =
  9 | 
 10 |     let private TAIGA_API_URL = "https://api.taiga.io/api/v1"
 11 | 
 12 |     let GetProjectIdBySlug authToken projectSlug : int =
 13 |         use webClient = new WebClient()
 14 |         webClient.Headers.Add "Content-Type: application/json"
 15 |         webClient.Headers.Add(sprintf "Authorization: Bearer %s" authToken)
 16 | 
 17 |         let response =
 18 |             webClient.DownloadString(
 19 |                 sprintf "%s/projects/by_slug?slug=%s" TAIGA_API_URL projectSlug
 20 |             )
 21 | 
 22 |         let jsonResponseDict =
 23 |             JavaScriptSerializer()
 24 |                 .Deserialize<Dictionary<string, obj>> response
 25 | 
 26 |         let projectId =
 27 |             match jsonResponseDict.TryGetValue "id" with
 28 |             | true, (:? int as value) -> value
 29 |             | _ ->
 30 |                 failwith(
 31 |                     "JSON response didn't include a string 'id' element? "
 32 |                     + response
 33 |                 )
 34 | 
 35 |         projectId
 36 | 
 37 |     let NumberOfUserStoriesInIssueByProjectIdAndIssueId
 38 |         authToken
 39 |         (projectId: int)
 40 |         refId
 41 |         : Option<int> =
 42 |         use webClient = new WebClient()
 43 |         webClient.Headers.Add "Content-Type: application/json"
 44 |         webClient.Headers.Add(sprintf "Authorization: Bearer %s" authToken)
 45 | 
 46 |         let response =
 47 |             try
 48 |                 Some(
 49 |                     webClient.DownloadString(
 50 |                         sprintf
 51 |                             "%s/issues/by_ref?ref=%d&project=%d"
 52 |                             TAIGA_API_URL
 53 |                             refId
 54 |                             projectId
 55 |                     )
 56 |                 )
 57 |             with
 58 |             | :? WebException as wex ->
 59 |                 match wex.Response with
 60 |                 | :? HttpWebResponse as webResponse ->
 61 |                     match webResponse.StatusCode with
 62 |                     | HttpStatusCode.NotFound -> None
 63 |                     | _ -> reraise()
 64 |                 | _ -> reraise()
 65 |             | _ -> reraise()
 66 | 
 67 |         match response with
 68 |         | None -> None
 69 |         | Some likelyJsonResponse ->
 70 |             let jsonResponseDict =
 71 |                 JavaScriptSerializer()
 72 |                     .Deserialize<Dictionary<string, obj>> likelyJsonResponse
 73 | 
 74 |             let generatedUserStories =
 75 |                 match jsonResponseDict.TryGetValue "generated_user_stories" with
 76 |                 | true, null -> 0
 77 |                 | false, _ -> 0
 78 |                 | true, (:? ArrayList as userStories) -> userStories.Count
 79 |                 | true, elementWithUnexpectedType ->
 80 |                     failwith(
 81 |                         sprintf
 82 |                             "Unexpected element of type %s"
 83 |                             (elementWithUnexpectedType.GetType().FullName)
 84 |                     )
 85 | 
 86 |             Some(generatedUserStories)
 87 | 
 88 |     let GetAuthToken username password =
 89 |         use webClient = new WebClient()
 90 |         webClient.Headers.Add "Content-Type: application/json"
 91 | 
 92 |         let response =
 93 |             webClient.UploadString(
 94 |                 sprintf "%s/auth" TAIGA_API_URL,
 95 |                 sprintf
 96 |                     "{ \"type\": \"normal\", \"username\": \"%s\", \"password\": \"%s\" }"
 97 |                     username
 98 |                     password
 99 |             )
100 | 
101 |         let jsonResponseDict =
102 |             JavaScriptSerializer()
103 |                 .Deserialize<Dictionary<string, obj>> response
104 | 
105 |         let authToken =
106 |             match jsonResponseDict.TryGetValue "auth_token" with
107 |             | true, (:? string as value) -> value
108 |             | _ ->
109 |                 failwith(
110 |                     "JSON response didn't include a string 'auth_token' element? "
111 |                     + response
112 |                 )
113 | 
114 |         authToken
115 | 


--------------------------------------------------------------------------------
/fsx-legacy.sln:
--------------------------------------------------------------------------------
 1 | 
 2 | Microsoft Visual Studio Solution File, Format Version 12.00
 3 | # Visual Studio 14
 4 | VisualStudioVersion = 14.0.25123.0
 5 | MinimumVisualStudioVersion = 10.0.40219.1
 6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fsdk", "Fsdk\Fsdk-legacy.fsproj", "{4634F264-784E-42DA-B5A1-FE72125DEAFC}"
 7 | EndProject
 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "fsxc", "fsxc\fsxc-legacy.fsproj", "{56DA5F03-8F7F-44AB-B692-5A24DB134A8B}"
 9 | EndProject
10 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Tools", "Tools", "{8E1108BE-590F-4C6D-8496-A8AAEB8594D8}"
11 | 	ProjectSection(SolutionItems) = preProject
12 | 		Tools\bump.fsx = Tools\bump.fsx
13 | 		Tools\replace.fsx = Tools\replace.fsx
14 | 		Tools\safeRun.fsx = Tools\safeRun.fsx
15 | 		Tools\nugetPush.fsx = Tools\nugetPush.fsx
16 | 		Tools\fsi.bat = Tools\fsi.bat
17 | 		Tools\gitPush1by1.fsx = Tools\gitPush1by1.fsx
18 | 	EndProjectSection
19 | EndProject
20 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "test", "test", "{848BC281-2B17-47DC-B24E-9BD27B013D02}"
21 | 	ProjectSection(SolutionItems) = preProject
22 | 		test\test.fs = test\test.fs
23 | 		test\test.fsx = test\test.fsx
24 | 		test\testRefLib.fsx = test\testRefLib.fsx
25 | 		test\testRefLibOutsideCurrentFolder.fsx = test\testRefLibOutsideCurrentFolder.fsx
26 | 		test\testProcessConcurrency.fsx = test\testProcessConcurrency.fsx
27 | 		test\testProcessConcurrencySample.fsx = test\testProcessConcurrencySample.fsx
28 | 		test\testTsv.fsx = test\testTsv.fsx
29 | 		test\testProcess.fsx = test\testProcess.fsx
30 | 		test\testProcessSample.fsx = test\testProcessSample.fsx
31 | 		test\testRefNugetLib.fsx = test\testRefNugetLib.fsx
32 | 		test\testFsiCommandLineArgs.fsx = test\testFsiCommandLineArgs.fsx
33 | 		test\testIfDef.fsx = test\testIfDef.fsx
34 | 		test\testRefNugetLibNewFormat.fsx = test\testRefNugetLibNewFormat.fsx
35 | 		test\testRefNugetLibNewFormatWithVersion.fsx = test\testRefNugetLibNewFormatWithVersion.fsx
36 | 	EndProjectSection
37 | EndProject
38 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "build", "build", "{DBAE02AB-5972-403C-B18B-ED1DFE362054}"
39 | 	ProjectSection(SolutionItems) = preProject
40 | 		configure.sh = configure.sh
41 | 		Makefile = Makefile
42 | 		scripts\install.sh = scripts\install.sh
43 | 		launcher.fsx = launcher.fsx
44 | 		scripts\build.sh = scripts\build.sh
45 | 		scripts\launcher.sh = scripts\launcher.sh
46 | 		compileFSharpScripts.fsx = compileFSharpScripts.fsx
47 | 		make.bat = make.bat
48 | 		scripts\make.fsx = scripts\make.fsx
49 | 		.github\workflows\CI.yml = .github\workflows\CI.yml
50 | 		scripts\runTests.fsx = scripts\runTests.fsx
51 | 		scripts\fsx.bat = scripts\fsx.bat
52 | 	EndProjectSection
53 | EndProject
54 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fsdk.Tests", "Fsdk.Tests\Fsdk.Tests-legacy.fsproj", "{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}"
55 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "fsx", "fsx\fsx-legacy.fsproj", "{14E47DE0-49B3-4B58-9627-8C3F10A21D24}"
56 | EndProject
57 | Global
58 | 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
59 | 		Debug|Any CPU = Debug|Any CPU
60 | 		Release|Any CPU = Release|Any CPU
61 | 	EndGlobalSection
62 | 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
63 | 		{4634F264-784E-42DA-B5A1-FE72125DEAFC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
64 | 		{4634F264-784E-42DA-B5A1-FE72125DEAFC}.Debug|Any CPU.Build.0 = Debug|Any CPU
65 | 		{4634F264-784E-42DA-B5A1-FE72125DEAFC}.Release|Any CPU.ActiveCfg = Release|Any CPU
66 | 		{4634F264-784E-42DA-B5A1-FE72125DEAFC}.Release|Any CPU.Build.0 = Release|Any CPU
67 | 		{56DA5F03-8F7F-44AB-B692-5A24DB134A8B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
68 | 		{56DA5F03-8F7F-44AB-B692-5A24DB134A8B}.Debug|Any CPU.Build.0 = Debug|Any CPU
69 | 		{56DA5F03-8F7F-44AB-B692-5A24DB134A8B}.Release|Any CPU.ActiveCfg = Release|Any CPU
70 | 		{56DA5F03-8F7F-44AB-B692-5A24DB134A8B}.Release|Any CPU.Build.0 = Release|Any CPU
71 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
72 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Debug|Any CPU.Build.0 = Debug|Any CPU
73 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Release|Any CPU.ActiveCfg = Release|Any CPU
74 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Release|Any CPU.Build.0 = Release|Any CPU
75 | 		{14E47DE0-49B3-4B58-9627-8C3F10A21D24}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
76 | 		{14E47DE0-49B3-4B58-9627-8C3F10A21D24}.Debug|Any CPU.Build.0 = Debug|Any CPU
77 | 		{14E47DE0-49B3-4B58-9627-8C3F10A21D24}.Release|Any CPU.ActiveCfg = Release|Any CPU
78 | 		{14E47DE0-49B3-4B58-9627-8C3F10A21D24}.Release|Any CPU.Build.0 = Release|Any CPU
79 | 	EndGlobalSection
80 | 	GlobalSection(SolutionProperties) = preSolution
81 | 		HideSolutionNode = FALSE
82 | 	EndGlobalSection
83 | EndGlobal
84 | 


--------------------------------------------------------------------------------
/fsx.sln:
--------------------------------------------------------------------------------
 1 | 
 2 | Microsoft Visual Studio Solution File, Format Version 12.00
 3 | # Visual Studio Version 16
 4 | VisualStudioVersion = 25.0.1703.8
 5 | MinimumVisualStudioVersion = 10.0.40219.1
 6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "fsxc", "fsxc\fsxc.fsproj", "{9E754152-E69A-4DB9-B23A-3B72C189FF5A}"
 7 | EndProject
 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Fsdk", "Fsdk\Fsdk.fsproj", "{B532D664-2864-4532-9673-3E52DD363BB9}"
 9 | EndProject
10 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "build", "build", "{17C46E45-4C73-4981-9EE4-686675C2DDBB}"
11 | 	ProjectSection(SolutionItems) = preProject
12 | 		configure.sh = configure.sh
13 | 		Makefile = Makefile
14 | 		scripts\install.sh = scripts\install.sh
15 | 		launcher.fsx = launcher.fsx
16 | 		scripts\build.sh = scripts\build.sh
17 | 		scripts\launcher.sh = scripts\launcher.sh
18 | 		compileFSharpScripts.fsx = compileFSharpScripts.fsx
19 | 		make.bat = make.bat
20 | 		scripts\make.fsx = scripts\make.fsx
21 | 		.github\workflows\CI.yml = .github\workflows\CI.yml
22 | 		scripts\runTests.fsx = scripts\runTests.fsx
23 | 		scripts\fsx.bat = scripts\fsx.bat
24 | 	EndProjectSection
25 | EndProject
26 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "test", "test", "{C51659D1-9E99-4C52-A7E4-DCD12922AE73}"
27 | 	ProjectSection(SolutionItems) = preProject
28 | 		test\test.fs = test\test.fs
29 | 		test\test.fsx = test\test.fsx
30 | 		test\testFsiCommandLineArgs.fsx = test\testFsiCommandLineArgs.fsx
31 | 		test\testIfDef.fsx = test\testIfDef.fsx
32 | 		test\testProcess.fsx = test\testProcess.fsx
33 | 		test\testProcessConcurrency.fsx = test\testProcessConcurrency.fsx
34 | 		test\testProcessConcurrencySample.fsx = test\testProcessConcurrencySample.fsx
35 | 		test\testProcessSample.fsx = test\testProcessSample.fsx
36 | 		test\testRefLib.fsx = test\testRefLib.fsx
37 | 		test\testRefLibOutsideCurrentFolder.fsx = test\testRefLibOutsideCurrentFolder.fsx
38 | 		test\testRefNugetLib.fsx = test\testRefNugetLib.fsx
39 | 		test\testRefNugetLibNewFormat.fsx = test\testRefNugetLibNewFormat.fsx
40 | 		test\testRefNugetLibNewFormatWithVersion.fsx = test\testRefNugetLibNewFormatWithVersion.fsx
41 | 		test\testLegacyFx.fsx = test\testLegacyFx.fsx
42 | 		test\testNonLegacyFx.fsx = test\testNonLegacyFx.fsx
43 | 	EndProjectSection
44 | EndProject
45 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Tools", "Tools", "{FD764CDA-F880-4954-BA6C-1FC678D64988}"
46 | 	ProjectSection(SolutionItems) = preProject
47 | 		Tools\bump.fsx = Tools\bump.fsx
48 | 		Tools\clean.fsx = Tools\clean.fsx
49 | 		Tools\nugetPush.fsx = Tools\nugetPush.fsx
50 | 		Tools\rename.fsx = Tools\rename.fsx
51 | 		Tools\replace.fsx = Tools\replace.fsx
52 | 		Tools\safeRun.fsx = Tools\safeRun.fsx
53 | 	EndProjectSection
54 | EndProject
55 | Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fsdk.Tests", "Fsdk.Tests\Fsdk.Tests.fsproj", "{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}"
56 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "fsx", "fsx\fsx.fsproj", "{534A9824-CD0A-47FC-AEF0-9A5F04021507}"
57 | EndProject
58 | Global
59 | 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
60 | 		Debug|Any CPU = Debug|Any CPU
61 | 		Release|Any CPU = Release|Any CPU
62 | 	EndGlobalSection
63 | 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
64 | 		{9E754152-E69A-4DB9-B23A-3B72C189FF5A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
65 | 		{9E754152-E69A-4DB9-B23A-3B72C189FF5A}.Debug|Any CPU.Build.0 = Debug|Any CPU
66 | 		{9E754152-E69A-4DB9-B23A-3B72C189FF5A}.Release|Any CPU.ActiveCfg = Release|Any CPU
67 | 		{9E754152-E69A-4DB9-B23A-3B72C189FF5A}.Release|Any CPU.Build.0 = Release|Any CPU
68 | 		{B532D664-2864-4532-9673-3E52DD363BB9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
69 | 		{B532D664-2864-4532-9673-3E52DD363BB9}.Debug|Any CPU.Build.0 = Debug|Any CPU
70 | 		{B532D664-2864-4532-9673-3E52DD363BB9}.Release|Any CPU.ActiveCfg = Release|Any CPU
71 | 		{B532D664-2864-4532-9673-3E52DD363BB9}.Release|Any CPU.Build.0 = Release|Any CPU
72 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
73 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Debug|Any CPU.Build.0 = Debug|Any CPU
74 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Release|Any CPU.ActiveCfg = Release|Any CPU
75 | 		{43BA7E25-975B-4DF9-B274-EEF6C806C1D0}.Release|Any CPU.Build.0 = Release|Any CPU
76 | 		{534A9824-CD0A-47FC-AEF0-9A5F04021507}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
77 | 		{534A9824-CD0A-47FC-AEF0-9A5F04021507}.Debug|Any CPU.Build.0 = Debug|Any CPU
78 | 		{534A9824-CD0A-47FC-AEF0-9A5F04021507}.Release|Any CPU.ActiveCfg = Release|Any CPU
79 | 		{534A9824-CD0A-47FC-AEF0-9A5F04021507}.Release|Any CPU.Build.0 = Release|Any CPU
80 | 	EndGlobalSection
81 | 	GlobalSection(SolutionProperties) = preSolution
82 | 		HideSolutionNode = FALSE
83 | 	EndGlobalSection
84 | 	GlobalSection(ExtensibilityGlobals) = postSolution
85 | 		SolutionGuid = {54AE85AF-9488-4563-80D5-97FACD773DDA}
86 | 	EndGlobalSection
87 | EndGlobal
88 | 


--------------------------------------------------------------------------------
/Tools/safeRun.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env fsx
  2 | 
  3 | open System
  4 | open System.IO
  5 | open System.Net
  6 | open System.Net.Sockets
  7 | open System.Linq
  8 | open System.Security.Cryptography
  9 | 
 10 | let NUMBER_OF_LINES_OF_BUFFER_TO_SHOW_IN_NOTIFICATION = 20
 11 | 
 12 | #r "System.Configuration"
 13 | open System.Configuration
 14 | 
 15 | #load "../Fsdk/Misc.fs"
 16 | #load "../Fsdk/Process.fs"
 17 | #load "../Fsdk/Unix.fs"
 18 | #load "../Fsdk/Git.fs"
 19 | #load "../Fsdk/Network.fs"
 20 | 
 21 | open Fsdk
 22 | 
 23 | open Process
 24 | 
 25 | let arguments = Misc.FsxOnlyArguments()
 26 | let argCount = arguments.Length
 27 | 
 28 | if (argCount = 0) then
 29 |     Console.Error.WriteLine(
 30 |         "This script expects command (and optionally arguments)"
 31 |     )
 32 | 
 33 |     Environment.Exit(1)
 34 | 
 35 | if (arguments.Any(fun arg -> arg.Contains(">"))
 36 |     || arguments.Any(fun arg -> arg.Contains("<"))) then
 37 |     Console.Error.WriteLine("This script doesn't support redirections")
 38 |     Environment.Exit(2)
 39 | 
 40 | let home = Environment.GetEnvironmentVariable("HOME")
 41 | 
 42 | if (String.IsNullOrWhiteSpace(home)) then
 43 |     failwith("This script assumes that $HOME is defined properly")
 44 | 
 45 | let homeLog = Path.Combine(home, "log")
 46 | 
 47 | Process
 48 |     .Execute(
 49 |         {
 50 |             Command = "mkdir"
 51 |             Arguments = sprintf "-p %s" homeLog
 52 |         },
 53 |         Echo.Off
 54 |     )
 55 |     .UnwrapDefault()
 56 | |> ignore<string>
 57 | 
 58 | let command = arguments.First()
 59 | let argumentsOfCommand = String.Join(" ", List.skip 1 arguments)
 60 | 
 61 | let commandName = (command.Split('/')).Last()
 62 | 
 63 | let now = DateTime.Now.ToString("dddHHmm")
 64 | 
 65 | let logForStdOutFileName = sprintf "%s.%s.out.log" commandName now
 66 | let logForStdErrFileName = sprintf "%s.%s.err.log" commandName now
 67 | let logForGenericStdErrFileName = sprintf "%s.%s.err.log" __SOURCE_FILE__ now
 68 | 
 69 | let logForStdOut = Path.Combine(homeLog, logForStdOutFileName)
 70 | let logForStdErr = Path.Combine(homeLog, logForStdErrFileName)
 71 | let logForGenericStdErr = Path.Combine(homeLog, logForGenericStdErrFileName)
 72 | 
 73 | let fullCommand =
 74 |     String.Format(
 75 |         "{0} {1} 1>{2} 2>{3}",
 76 |         command,
 77 |         argumentsOfCommand,
 78 |         logForStdOut,
 79 |         logForStdErr
 80 |     )
 81 | 
 82 | let proc = Unix.ExecuteBashCommand(fullCommand, Echo.Off)
 83 | 
 84 | match proc.Result with
 85 | | ProcessResultState.Success _ ->
 86 |     let stdErrLog = new FileInfo(logForStdErr)
 87 | 
 88 |     if (stdErrLog.Exists && stdErrLog.Length = 0L) then
 89 |         stdErrLog.Delete()
 90 | | _ ->
 91 | 
 92 | #if LEGACY_FRAMEWORK
 93 |     let stdErrLines = File.ReadAllLines(logForStdErr)
 94 | 
 95 |     let lines =
 96 |         if (stdErrLines.Length = 0
 97 |             || (stdErrLines.Length = 1
 98 |                 && String.IsNullOrWhiteSpace(stdErrLines.[0].Trim()))) then
 99 |             File.ReadAllLines(logForStdOut)
100 |         else
101 |             stdErrLines
102 | 
103 |     let skip =
104 |         Math.Max(
105 |             0,
106 |             lines.Length - NUMBER_OF_LINES_OF_BUFFER_TO_SHOW_IN_NOTIFICATION
107 |         )
108 | 
109 |     let lastLines = (Environment.NewLine, lines.Skip(skip)) |> String.Join
110 | 
111 |     try
112 |         Network.SlackNotify(
113 |             String.Format(
114 |                 "Error running '{0} {1}':{2}{3}",
115 |                 command,
116 |                 argumentsOfCommand,
117 |                 Environment.NewLine,
118 |                 lastLines
119 |             )
120 |         )
121 |     with
122 |     | ex ->
123 |         File.WriteAllText(logForGenericStdErr, ex.ToString())
124 | 
125 |         Network.SlackNotify(
126 |             String.Format(
127 |                 "Error trying to notify problem to Slack about '{0} {1}': check {2}",
128 |                 command,
129 |                 argumentsOfCommand,
130 |                 logForGenericStdErr
131 |             )
132 |         )
133 | #else
134 |     ()
135 | #endif
136 | 
137 | // make 'foo.last.out|err.log' symlinks pointing to last log
138 | let logForLastStdOutName = sprintf "%s.last.out.log" commandName
139 | let logForLastStdErrName = sprintf "%s.last.err.log" commandName
140 | let logForLastStdOutSymLink = Path.Combine(homeLog, logForLastStdOutName)
141 | let logForLastStdErrSymLink = Path.Combine(homeLog, logForLastStdErrName)
142 | 
143 | Process
144 |     .Execute(
145 |         {
146 |             Command = "ln"
147 |             Arguments = sprintf "-fs %s %s" logForStdOut logForLastStdOutSymLink
148 |         },
149 |         Echo.Off
150 |     )
151 |     .UnwrapDefault()
152 | |> ignore<string>
153 | 
154 | Process
155 |     .Execute(
156 |         {
157 |             Command = "ln"
158 |             Arguments = sprintf "-fs %s %s" logForStdErr logForLastStdErrSymLink
159 |         },
160 |         Echo.Off
161 |     )
162 |     .UnwrapDefault()
163 | |> ignore<string>
164 | 


--------------------------------------------------------------------------------
/compileFSharpScripts.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env fsx
  2 | 
  3 | open System
  4 | open System.IO
  5 | open System.Linq
  6 | 
  7 | #r "System.Configuration"
  8 | open System.Configuration
  9 | 
 10 | #load "Fsdk/Misc.fs"
 11 | #load "Fsdk/Process.fs"
 12 | 
 13 | open Fsdk
 14 | open Fsdk.Process
 15 | 
 16 | let fsxRootDir = __SOURCE_DIRECTORY__ |> DirectoryInfo
 17 | let fsxTestsDir = Path.Combine(fsxRootDir.FullName, "test") |> DirectoryInfo
 18 | 
 19 | let rec FindFsxc(nestedCall: bool) : bool * FileInfo =
 20 | #if !LEGACY_FRAMEWORK
 21 |     let fsxCompiler = "fsxc.dll"
 22 | #else
 23 |     let fsxCompiler = "fsxc.exe"
 24 | #endif
 25 | 
 26 |     let fsxcBinDir = Path.Combine(__SOURCE_DIRECTORY__, "fsxc", "bin")
 27 | 
 28 |     let findFsxcExeFiles() =
 29 |         Directory.GetFiles(fsxcBinDir, fsxCompiler, SearchOption.AllDirectories)
 30 | 
 31 |     if not(Directory.Exists fsxcBinDir) || not(findFsxcExeFiles().Any()) then
 32 |         if nestedCall then
 33 |             Console.Error.WriteLine(
 34 |                 sprintf "'%s' compilation didn't work?" fsxCompiler
 35 |             )
 36 | 
 37 |             Environment.Exit 1
 38 | 
 39 |         let prevCurrentDir = Directory.GetCurrentDirectory()
 40 |         Directory.SetCurrentDirectory fsxRootDir.FullName
 41 | 
 42 |         let configureProc =
 43 |             Process.Execute(
 44 |                 {
 45 |                     Command = "./configure.sh"
 46 |                     Arguments = String.Empty
 47 |                 },
 48 |                 Echo.All
 49 |             )
 50 | 
 51 |         configureProc.UnwrapDefault() |> ignore<string>
 52 | 
 53 |         let makeProc =
 54 |             Process.Execute(
 55 |                 {
 56 |                     Command = "make"
 57 |                     Arguments = String.Empty
 58 |                 },
 59 |                 Echo.All
 60 |             )
 61 | 
 62 |         match makeProc.Result with
 63 |         | Error _ ->
 64 |             Console.WriteLine()
 65 |             Console.Out.Flush()
 66 |             failwith "Compilation failed"
 67 |         | _ -> ()
 68 | 
 69 |         Directory.SetCurrentDirectory prevCurrentDir
 70 | 
 71 |         FindFsxc true
 72 | 
 73 |     elif findFsxcExeFiles().Count() > 1 then
 74 | 
 75 |         Console.Error.WriteLine(
 76 |             sprintf
 77 |                 "More than one %s file found (%s), please just leave one"
 78 |                 fsxCompiler
 79 |                 (String.Join(", ", findFsxcExeFiles()))
 80 |         )
 81 | 
 82 |         Environment.Exit 1
 83 |         failwith "Unreachable"
 84 | 
 85 |     else
 86 |         nestedCall, findFsxcExeFiles().Single() |> FileInfo
 87 | 
 88 | let compilationWasNeeded, fsxLocation = FindFsxc false
 89 | 
 90 | Console.WriteLine("Checking if all .fsx scripts build")
 91 | 
 92 | let fsxScripts =
 93 |     Directory.GetFiles(
 94 |         Directory.GetCurrentDirectory(),
 95 |         "*.fsx",
 96 |         SearchOption.AllDirectories
 97 |     )
 98 | 
 99 | let buildFsxScript (script: string) (soFar: bool) : bool =
100 |     if (script = null) then
101 |         raise <| ArgumentNullException("script")
102 | 
103 |     Console.WriteLine(sprintf "Building %s" script)
104 | 
105 |     let proc =
106 |         Process.Execute(
107 |             {
108 | #if !LEGACY_FRAMEWORK
109 |                 Command = "dotnet"
110 |                 Arguments = sprintf "%s -k %s" fsxLocation.FullName script
111 | #else
112 |                 Command = fsxLocation.FullName
113 |                 Arguments = sprintf "-k %s" script
114 | #endif
115 |             },
116 |             Echo.OutputOnly
117 |         )
118 | 
119 |     let success =
120 |         match proc.Result with
121 |         | Success _ -> true
122 |         | WarningsOrAmbiguous output ->
123 |             output.PrintToConsole()
124 |             Console.WriteLine()
125 |             Console.Out.Flush()
126 |             failwith "Unexpected 'fsx' output ^ (with warnings?)"
127 |         | _ -> false
128 | 
129 |     Console.WriteLine()
130 | 
131 |     (success && soFar)
132 | 
133 | let rec buildAll (scripts: list<string>) (soFar: bool) : bool =
134 |     match scripts with
135 |     | [] -> soFar
136 |     | script :: tail ->
137 |         let scriptFile = FileInfo script
138 | 
139 |         let binFolder =
140 |             sprintf
141 |                 "%c%s%c"
142 |                 Path.DirectorySeparatorChar
143 |                 "bin"
144 |                 Path.DirectorySeparatorChar
145 | 
146 |         let skip =
147 |             // if compilation was needed, it's likely we are running under a
148 |             // repo which is not fsx itself, so we don't want to compile fsx's
149 |             // test scripts (because they have dependencies)
150 |             if compilationWasNeeded
151 |                && scriptFile.Directory.FullName = fsxTestsDir.FullName then
152 |                 true
153 |             elif scriptFile.FullName.Contains binFolder then
154 |                 true
155 |             else
156 | #if !LEGACY_FRAMEWORK
157 |                 scriptFile.FullName.EndsWith "testLegacyFx.fsx"
158 | #else
159 |                 scriptFile.FullName.EndsWith "testNonLegacyFx.fsx"
160 | #endif
161 | 
162 |         if skip then
163 |             Console.WriteLine(sprintf "Skipping %s" script)
164 |             buildAll tail soFar
165 |         else
166 |             let sofarPlusOne = buildFsxScript script soFar
167 |             buildAll tail sofarPlusOne
168 | 
169 | let scripts = List.ofArray fsxScripts
170 | let allCompile = buildAll scripts true
171 | 
172 | if allCompile then
173 |     Console.WriteLine("Success")
174 |     Environment.Exit(0)
175 | else
176 |     Console.WriteLine("Some script(s) had errors")
177 |     Environment.Exit(1)
178 | 


--------------------------------------------------------------------------------
/.editorconfig:
--------------------------------------------------------------------------------
  1 | [*.{fs,fsx}]
  2 | end_of_line=lf
  3 | indent_size=4
  4 | max_line_length=80
  5 | fsharp_semicolon_at_end_of_line=false
  6 | fsharp_space_before_parameter=false
  7 | fsharp_space_before_lowercase_invocation=false
  8 | fsharp_space_before_uppercase_invocation=false
  9 | fsharp_space_before_class_constructor=false
 10 | fsharp_space_before_member=false
 11 | fsharp_space_before_colon=false
 12 | fsharp_space_after_comma=true
 13 | fsharp_space_before_semicolon=false
 14 | fsharp_space_after_semicolon=true
 15 | fsharp_indent_on_try_with=false
 16 | fsharp_space_around_delimiter=true
 17 | fsharp_max_if_then_else_short_width=0
 18 | fsharp_max_infix_operator_expression=80
 19 | fsharp_max_record_width=0
 20 | fsharp_max_function_binding_width=0
 21 | fsharp_max_value_binding_width=80
 22 | fsharp_multiline_block_brackets_on_same_column=true
 23 | fsharp_newline_between_type_definition_and_members=true
 24 | fsharp_keep_if_then_in_same_line=true
 25 | fsharp_strict_mode=false
 26 | fsharp_multi_line_lambda_closing_newline=true
 27 | fsharp_disable_elmish_syntax=true
 28 | 
 29 | [*.cs]
 30 | #Core editorconfig formatting - indentation
 31 | 
 32 | #use soft tabs (spaces) for indentation
 33 | indent_style = space
 34 | 
 35 | #Formatting - new line options
 36 | 
 37 | #place catch statements on a new line
 38 | csharp_new_line_before_catch = true
 39 | #place else statements on a new line
 40 | csharp_new_line_before_else = true
 41 | #require finally statements to be on a new line after the closing brace
 42 | csharp_new_line_before_finally = true
 43 | #require members of object intializers to be on separate lines
 44 | csharp_new_line_before_members_in_object_initializers = true
 45 | #require braces to be on a new line for methods, control_blocks, object_collection_array_initializers, and types (also known as "Allman" style)
 46 | csharp_new_line_before_open_brace = methods, control_blocks, object_collection_array_initializers, types
 47 | 
 48 | #Formatting - organize using options
 49 | 
 50 | #sort System.* using directives alphabetically, and place them before other usings
 51 | dotnet_sort_system_directives_first = true
 52 | 
 53 | #Formatting - spacing options
 54 | 
 55 | #require NO space between a cast and the value
 56 | csharp_space_after_cast = false
 57 | #require a space before the colon for bases or interfaces in a type declaration
 58 | csharp_space_after_colon_in_inheritance_clause = true
 59 | #require a space after a keyword in a control flow statement such as a for loop
 60 | csharp_space_after_keywords_in_control_flow_statements = true
 61 | #require a space before the colon for bases or interfaces in a type declaration
 62 | csharp_space_before_colon_in_inheritance_clause = true
 63 | #remove space within empty argument list parentheses
 64 | csharp_space_between_method_call_empty_parameter_list_parentheses = false
 65 | #remove space between method call name and opening parenthesis
 66 | csharp_space_between_method_call_name_and_opening_parenthesis = false
 67 | #do not place space characters after the opening parenthesis and before the closing parenthesis of a method call
 68 | csharp_space_between_method_call_parameter_list_parentheses = false
 69 | #place a space character after the opening parenthesis and before the closing parenthesis of a method declaration parameter list.
 70 | csharp_space_between_method_declaration_parameter_list_parentheses = false
 71 | 
 72 | #Formatting - wrapping options
 73 | 
 74 | #leave code block on single line
 75 | csharp_preserve_single_line_blocks = true
 76 | 
 77 | #Style - Code block preferences
 78 | 
 79 | #prefer no curly braces if allowed
 80 | csharp_prefer_braces = false:suggestion
 81 | 
 82 | #Style - expression bodied member options
 83 | 
 84 | #prefer block bodies for methods
 85 | csharp_style_expression_bodied_methods = false:suggestion
 86 | #prefer expression-bodied members for properties
 87 | csharp_style_expression_bodied_properties = true:suggestion
 88 | 
 89 | #Style - Expression-level  preferences
 90 | 
 91 | #prefer default over default(T)
 92 | csharp_prefer_simple_default_expression = true:suggestion
 93 | #prefer objects to be initialized using object initializers when possible
 94 | dotnet_style_object_initializer = true:suggestion
 95 | 
 96 | #Style - implicit and explicit types
 97 | 
 98 | #prefer var over explicit type in all cases, unless overridden by another code style rule
 99 | csharp_style_var_elsewhere = true:suggestion
100 | #prefer var is used to declare variables with built-in system types such as int
101 | csharp_style_var_for_built_in_types = true:suggestion
102 | #prefer explicit type over var when the type is already mentioned on the right-hand side of a declaration
103 | csharp_style_var_when_type_is_apparent = false:suggestion
104 | 
105 | #Style - language keyword and framework type options
106 | 
107 | #prefer the language keyword for local variables, method parameters, and class members, instead of the type name, for types that have a keyword to represent them
108 | dotnet_style_predefined_type_for_locals_parameters_members = true:suggestion
109 | 
110 | #Style - modifier options
111 | 
112 | #prefer accessibility modifiers to be declared except for public interface members. This will currently not differ from always and will act as future proofing for if C# adds default interface methods.
113 | dotnet_style_require_accessibility_modifiers = for_non_interface_members:suggestion
114 | 
115 | #Style - Modifier preferences
116 | 
117 | #when this rule is set to a list of modifiers, prefer the specified ordering.
118 | csharp_preferred_modifier_order = public,private,protected,static,override,readonly,abstract,async:suggestion
119 | 
120 | #Style - qualification options
121 | 
122 | #prefer fields not to be prefaced with this. or Me. in Visual Basic
123 | dotnet_style_qualification_for_field = false:suggestion
124 | #prefer methods not to be prefaced with this. or Me. in Visual Basic
125 | dotnet_style_qualification_for_method = false:suggestion
126 | #prefer properties not to be prefaced with this. or Me. in Visual Basic
127 | dotnet_style_qualification_for_property = false:suggestion
128 | 


--------------------------------------------------------------------------------
/ReadMe.md:
--------------------------------------------------------------------------------
  1 | # FSX
  2 | 
  3 | ## PUBLIC SERVICE ANNOUNCEMENT
  4 | 
  5 | THIS REPO IS FACING A COMPLETE OVERHAUL/REVAMP/RENOVATION IN ORDER TO SUPPORT .NET6.
  6 | 
  7 | Unfinished tasks so far:
  8 | * Revamp this ReadMe.md file to remove any mentions to Mono or the legacy .NET4.x framework.
  9 | * Remove legacy framework support (so that build system can converge into .fsx files instead of autotools in Unix + fsx in Windows).
 10 | * Allow fsxc && fsx disable warnAsError (via --w flag? or --ignore-warnings).
 11 | * After doing the above, make both fsx and fsxc always enable warnAsError for the FS0020 warning described in https://stackoverflow.com/questions/38202685/fsx-script-ignoring-a-function-call-when-i-add-a-parameter-to-it
 12 | * Try creating VMs for CI that uninstall .NETCore/.NET6 completely (not just the dotnet executable removal hack), to make sure legacy framework build still works there.
 13 | * Try creating VMs for CI that uninstall Mono/.NET4.x completey (e.g. for macOS see: https://github.com/mono/website/commit/490797429d4b92584394292ff69fbdc0eb002948 )
 14 | 
 15 | 
 16 | ## Motivation
 17 | 
 18 | FSX is the ideal tool for people that use F# for their scripting needs.
 19 | 
 20 | The best way to describe it is to start first with some questions:
 21 | * Have you found yourself waiting many seconds until your big script is parsed by FSI and run? This is unacceptable when doing many small changes and expecting a quick feedback loop to test them.
 22 | * Do you have long-running F# scripts that cause too much memory usage in your server?
 23 | * Have you found that your scripts could bitrot over time (i.e. not compile anymore) especially when using helper functions in .fs files loaded by them?
 24 | 
 25 | These are the main annoyances when working with F# scripting. Granted, F#+FSI is already much better than the alternatives (as many more errors are thrown much earlier than at runtime, and as strongly-typed functional languages are generally faster). However, we can do better.
 26 | 
 27 | To the above three questions we could even follow-up with new ones:
 28 | * Couldn't we make FSI only compile what's changed, and reuse binaries from a previous run, to speed this up?
 29 | * Couldn't we run our script without FSI given that FSI eats a lot of memory (for REPL features, which scripts don't need)?
 30 | * Couldn't we have a CI approach that takes care of our scripts in a similar way as we do with (msbuild-ed) C#/F# code?
 31 | 
 32 | FSX answers all of these latter questions with a categorical YES!
 33 | 
 34 | The creation of FSX was inspired by several facts:
 35 | * FSI is slower than the F# compiler (obviously).
 36 | * There should be an easy and programatic way to compile an F# script without trying to run it (see https://stackoverflow.com/questions/33468298/f-how-can-i-compile-and-then-release-a-file-fsx ).
 37 | * FSI (or the components required to run it) suffers from bugs frequently. Examples:
 38 |   * If your version of Mono is too old (e.g. 4.6.2, the version that comes by default in Ubuntu 18.04), then it might crash with a segmentation fault. More info: https://bugzilla.xamarin.com/show_bug.cgi?id=42417 .
 39 |   * If your version of Mono is not too old, but your version of F# is not too new (e.g. what happens exactly with Ubuntu 19.04), then FSI might not work at all. More info: https://github.com/fsharp/fsharp/issues/740 .
 40 | * FSI stands for F Sharp **Interactive**, which means that it's not really suited for scripting but more for debugging:
 41 |   * It doesn't treat warnings as errors by default (you would need to remember to use the flag --warnaserror when calling fsharpi, which is not handy).
 42 |   * Because of the previous point above about warnings, it can even cancel the advantage of the promise of "statically-compiled scripts" altogether, because what should be a compilation error could be translated to a runtime error when using currified arguments, due to FSI defaulting to "interactive" needs. (More info: https://stackoverflow.com/questions/38202685/fsx-script-ignoring-a-function-call-when-i-add-a-parameter-to-it )
 43 |   * AFAIK there's no way to use flags in a shebang (so can't use `#!/usr/bin/env fsharpi --warnaserror` as the flag gets ignored). Note that using fsx in shebang, however, will treat warnings as errors.
 44 |   * It can consume a lot of memory, just compare it this way:
 45 | 
 46 | ```
 47 | echo $'#!/usr/bin/env fsharpi\nSystem.Threading.Thread.Sleep(999999999)'>testfsi.fsx
 48 | echo $'#!/usr/bin/env fsx\nSystem.Threading.Thread.Sleep(999999999)'>testfsx.fsx
 49 | chmod u+x test*.fsx
 50 | nohup ./testfsi.fsx >/dev/null 2>&1 &
 51 | nohup ./testfsx.fsx >/dev/null 2>&1 &
 52 | ps aux | grep testfs
 53 | ```
 54 | 
 55 | In my machine, the above prints:
 56 | ```
 57 | andres   23596 16.6  0.9 254504 148268 pts/24  Sl   03:38   0:01 cli /usr/lib/cli/fsharp/fsi.exe --exename:fsharpi ./testfsi.fsx
 58 | andres   23600  0.0  0.0 129332 15936 pts/24   Sl   03:38   0:00 mono bin/./testfsx.fsx.exe
 59 | ```
 60 | 
 61 | Which is a huge difference in memory footprint.
 62 | 
 63 | 
 64 | ## How to install/use?
 65 | 
 66 | 
 67 | ### Installation
 68 | 
 69 | In Linux/macOS, the old-fashioned way by cloning and compiling it yourself:
 70 | 
 71 | ```
 72 | ./configure.sh --prefix=/usr/local
 73 | make
 74 | sudo make install
 75 | ```
 76 | 
 77 | (If you're using Windows, just build with "make.bat" and install with "make install".)
 78 | 
 79 | 
 80 | ### Usage
 81 | 
 82 | 
 83 | #### Execution
 84 | 
 85 | After installing, you can already use the `#!/usr/bin/env fsx` shebang in your scripts.
 86 | 
 87 | If you want to use fsx without having to change the shebang of all your scripts, just
 88 | run `fsx yourscript.fsx` every time.
 89 | 
 90 | 
 91 | #### Compilation
 92 | 
 93 | For your CI needs (to compile all scripts in your repo without executing them), you could call `fsxc` using `find` in your CI step.
 94 | 
 95 | An example of how to do this with GitHub Actions, is this YML fragment that you could add to your workflow existing in your `.github/workflows/` folder:
 96 | 
 97 | ```
 98 |     - name: compile F# scripts
 99 |       shell: bash
100 |       run: |
101 |         dotnet new tool-manifest
102 |         dotnet tool install fsxc
103 |         find . -type f -name "*.fsx" | xargs -t -I {} dotnet fsxc {}
104 | ```
105 | 
106 | 


--------------------------------------------------------------------------------
/scripts/publish.fsx:
--------------------------------------------------------------------------------
  1 | open System
  2 | open System.IO
  3 | 
  4 | #r "System.Configuration"
  5 | open System.Configuration
  6 | 
  7 | #load "../Fsdk/Misc.fs"
  8 | #load "../Fsdk/Process.fs"
  9 | #load "../Fsdk/Git.fs"
 10 | #load "../Fsdk/Network.fs"
 11 | 
 12 | open Fsdk
 13 | open Fsdk.Process
 14 | 
 15 | let rootDir = Path.Combine(__SOURCE_DIRECTORY__, "..") |> DirectoryInfo
 16 | 
 17 | let githubRef = Environment.GetEnvironmentVariable "GITHUB_REF"
 18 | 
 19 | if String.IsNullOrEmpty githubRef then
 20 |     Console.Error.WriteLine
 21 |         "This script is only meant to be launched within a CI pipeline"
 22 | 
 23 |     Environment.Exit 1
 24 | 
 25 | let versionConfigFileName = "version.config"
 26 | 
 27 | let versionConfigFile =
 28 |     Path.Combine(rootDir.FullName, versionConfigFileName) |> FileInfo
 29 | 
 30 | let tagPrefix = "refs/tags/"
 31 | 
 32 | let fullVersion =
 33 |     if githubRef.StartsWith tagPrefix then
 34 |         githubRef.Substring tagPrefix.Length
 35 |     else
 36 |         let baseVersionTokenString = "BaseVersion="
 37 | 
 38 |         let rec ReadBaseVersion(lines: seq<string>) =
 39 |             match Seq.tryHead lines with
 40 |             | None -> None
 41 |             | Some line ->
 42 |                 if line.StartsWith baseVersionTokenString then
 43 |                     line.Substring baseVersionTokenString.Length |> Some
 44 |                 else
 45 |                     ReadBaseVersion <| Seq.tail lines
 46 | 
 47 |         let maybeBaseVersion =
 48 |             ReadBaseVersion <| File.ReadAllLines versionConfigFile.FullName
 49 | 
 50 |         match maybeBaseVersion with
 51 |         | None ->
 52 |             failwithf
 53 |                 "%s file should contain a line with %s var set"
 54 |                 versionConfigFile.Name
 55 |                 baseVersionTokenString
 56 |         | Some baseVersion ->
 57 |             let procResult =
 58 |                 Process.Execute(
 59 |                     {
 60 |                         Command = "git"
 61 |                         Arguments = sprintf "tag %s" baseVersion
 62 |                     },
 63 |                     Echo.Off
 64 |                 )
 65 | 
 66 |             match procResult.Result with
 67 |             | ProcessResultState.Error _ ->
 68 |                 failwithf
 69 |                     "Shouldn't use %s as BaseVersion (in %s) if tag %s already exists (for pushing prereleases)"
 70 |                     baseVersion
 71 |                     versionConfigFileName
 72 |                     baseVersion
 73 |             | _ -> ()
 74 | 
 75 |             let nugetPush =
 76 |                 Path.Combine(rootDir.FullName, "Tools", "nugetPush.fsx")
 77 |                 |> FileInfo
 78 | 
 79 |             // to disable welcome msg, see https://stackoverflow.com/a/70493818/544947
 80 |             Environment.SetEnvironmentVariable("DOTNET_NOLOGO", "true")
 81 | 
 82 |             let fullVersion =
 83 |                 Process
 84 |                     .Execute(
 85 |                         {
 86 |                             Command = "dotnet"
 87 |                             Arguments =
 88 |                                 sprintf
 89 |                                     "fsi %s --output-version %s"
 90 |                                     nugetPush.FullName
 91 |                                     baseVersion
 92 |                         },
 93 |                         Echo.Off
 94 |                     )
 95 |                     .UnwrapDefault()
 96 |                     .Trim()
 97 | 
 98 |             fullVersion
 99 | 
100 | let Pack proj =
101 |     Process
102 |         .Execute(
103 |             {
104 |                 Command = "dotnet"
105 |                 Arguments =
106 |                     sprintf
107 |                         "pack %s/%s.fsproj -property:PackageVersion=%s"
108 |                         proj
109 |                         proj
110 |                         fullVersion
111 |             },
112 |             Echo.All
113 |         )
114 |         .UnwrapDefault()
115 |     |> ignore
116 | 
117 | let projs = [ "fsxc"; "Fsdk"; "fsx" ]
118 | 
119 | for proj in projs do
120 |     Pack proj
121 | 
122 | let defaultBranch = "master"
123 | let branchPrefix = "refs/heads/"
124 | let prPrefix = "refs/pull/"
125 | 
126 | if githubRef.StartsWith prPrefix then
127 |     Console.WriteLine(sprintf "CI running in PR, skipping dotnet nuget push")
128 |     Environment.Exit 0
129 | elif githubRef.StartsWith branchPrefix then
130 |     if not(githubRef.StartsWith(sprintf "%s%s" branchPrefix defaultBranch)) then
131 |         Console.WriteLine(
132 |             sprintf
133 |                 "Branch different than '%s', skipping dotnet nuget push"
134 |                 defaultBranch
135 |         )
136 | 
137 |         Environment.Exit 0
138 | elif not(githubRef.StartsWith tagPrefix) then
139 |     failwithf "Unexpected GITHUB_REF value: %s" githubRef
140 | 
141 | let nugetApiKeyVarName = "NUGET_API_KEY"
142 | let nugetApiKey = Environment.GetEnvironmentVariable nugetApiKeyVarName
143 | 
144 | if String.IsNullOrEmpty nugetApiKey then
145 |     Console.WriteLine(
146 |         sprintf
147 |             "Secret '%s' not set as env var, skipping dotnet nuget push"
148 |             nugetApiKeyVarName
149 |     )
150 | 
151 |     Environment.Exit 0
152 | 
153 | let githubEventName = Environment.GetEnvironmentVariable "GITHUB_EVENT_NAME"
154 | 
155 | match githubEventName with
156 | | "push" ->
157 |     let nugetApiSource = "https://api.nuget.org/v3/index.json"
158 | 
159 |     let NugetPush proj =
160 |         Process
161 |             .Execute(
162 |                 {
163 |                     Command = "dotnet"
164 |                     Arguments =
165 |                         sprintf
166 |                             "nuget push %s/nupkg/%s.%s.nupkg --api-key %s --source %s"
167 |                             proj
168 |                             proj
169 |                             fullVersion
170 |                             nugetApiKey
171 |                             nugetApiSource
172 |                 },
173 |                 Echo.All
174 |             )
175 |             .UnwrapDefault()
176 |         |> ignore
177 | 
178 |     for proj in projs do
179 |         NugetPush proj
180 | 
181 | | null
182 | | "" -> failwith "The env var for github event name should have a value"
183 | 
184 | | _ ->
185 |     Console.WriteLine
186 |         "Github event name is not 'push', skipping dotnet nuget push"
187 | 
188 |     Environment.Exit 0
189 | 


--------------------------------------------------------------------------------
/Tools/bump.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env fsharpi
  2 | 
  3 | open System
  4 | open System.IO
  5 | 
  6 | #r "System.Configuration"
  7 | open System.Configuration
  8 | 
  9 | #load "../Fsdk/Misc.fs"
 10 | #load "../Fsdk/Process.fs"
 11 | 
 12 | open Fsdk
 13 | open Fsdk.Process
 14 | 
 15 | let IsStableRevision revision =
 16 |     (int revision % 2) = 0
 17 | 
 18 | let Bump(toStable: bool) : Version * Version =
 19 |     let rootDir = DirectoryInfo(Path.Combine(__SOURCE_DIRECTORY__, ".."))
 20 |     let fullVersion = Misc.GetCurrentVersion(rootDir)
 21 |     let androidVersion = fullVersion.MinorRevision
 22 | 
 23 |     if toStable && IsStableRevision androidVersion then
 24 |         failwith
 25 |             "bump script expects you to be in unstable version currently, but we found a stable"
 26 | 
 27 |     if (not toStable) && (not(IsStableRevision androidVersion)) then
 28 |         failwith
 29 |             "sanity check failed, post-bump should happen in a stable version"
 30 | 
 31 |     let newFullVersion =
 32 |         if Misc.FsxOnlyArguments().Length > 0 then
 33 |             if Misc.FsxOnlyArguments().Length > 1 then
 34 |                 Console.Error.WriteLine "Only one argument supported, not more"
 35 |                 Environment.Exit 1
 36 |                 failwith "Unreachable"
 37 |             else
 38 |                 let full = Version(Misc.FsxOnlyArguments().Head)
 39 |                 full
 40 |         else
 41 |             let newVersion = androidVersion + 1s
 42 | 
 43 |             let full =
 44 |                 Version(
 45 |                     sprintf
 46 |                         "%i.%i.%i.%i"
 47 |                         fullVersion.Major
 48 |                         fullVersion.Minor
 49 |                         fullVersion.Build
 50 |                         newVersion
 51 |                 )
 52 | 
 53 |             full
 54 | 
 55 |     let replaceScript = Path.Combine(__SOURCE_DIRECTORY__, "replace.fsx")
 56 | 
 57 |     Process
 58 |         .Execute(
 59 |             {
 60 |                 Command = replaceScript
 61 |                 Arguments =
 62 |                     sprintf
 63 |                         "%s %s"
 64 |                         (fullVersion.ToString())
 65 |                         (newFullVersion.ToString())
 66 |             },
 67 |             Echo.Off
 68 |         )
 69 |         .UnwrapDefault()
 70 |     |> ignore<string>
 71 | 
 72 |     // this code is weird, I know, but it's to avoid replace.fsx to change this script itself!
 73 |     let pluralSuffix = "s"
 74 | 
 75 |     let artifactsExpiry =
 76 |         if toStable then
 77 |             sprintf "50day%s 50year%s" pluralSuffix pluralSuffix
 78 |         else
 79 |             sprintf "50year%s 50day%s" pluralSuffix pluralSuffix
 80 | 
 81 |     Process
 82 |         .Execute(
 83 |             {
 84 |                 Command = replaceScript
 85 |                 Arguments = artifactsExpiry
 86 |             },
 87 |             Echo.Off
 88 |         )
 89 |         .UnwrapDefault()
 90 |     |> ignore<string>
 91 | 
 92 |     fullVersion, newFullVersion
 93 | 
 94 | 
 95 | let GitCommit (fullVersion: Version) (newFullVersion: Version) =
 96 |     Process
 97 |         .Execute(
 98 |             {
 99 |                 Command = "git"
100 |                 Arguments = "add version.config"
101 |             },
102 |             Echo.Off
103 |         )
104 |         .UnwrapDefault()
105 |     |> ignore<string>
106 | 
107 |     Process
108 |         .Execute(
109 |             {
110 |                 Command = "git"
111 |                 Arguments = "add snap/snapcraft.yaml"
112 |             },
113 |             Echo.Off
114 |         )
115 |         .UnwrapDefault()
116 |     |> ignore<string>
117 | 
118 |     Process
119 |         .Execute(
120 |             {
121 |                 Command = "git"
122 |                 Arguments = "add Fsdk/AssemblyInfo.fs"
123 |             },
124 |             Echo.Off
125 |         )
126 |         .UnwrapDefault()
127 |     |> ignore<string>
128 | 
129 |     Process
130 |         .Execute(
131 |             {
132 |                 Command = "git"
133 |                 Arguments = "add .gitlab-ci.yml"
134 |             },
135 |             Echo.Off
136 |         )
137 |         .UnwrapDefault()
138 |     |> ignore<string>
139 | 
140 |     let commitMessage =
141 |         sprintf
142 |             "Bump version: %s -> %s"
143 |             (fullVersion.ToString())
144 |             (newFullVersion.ToString())
145 | 
146 |     let finalCommitMessage =
147 |         if IsStableRevision fullVersion.MinorRevision then
148 |             sprintf "(Post)%s" commitMessage
149 |         else
150 |             commitMessage
151 | 
152 |     Process
153 |         .Execute(
154 |             {
155 |                 Command = "git"
156 |                 Arguments = sprintf "commit -m \"%s\"" finalCommitMessage
157 |             },
158 |             Echo.Off
159 |         )
160 |         .UnwrapDefault()
161 |     |> ignore<string>
162 | 
163 | let GitTag(newFullVersion: Version) =
164 |     if not(IsStableRevision newFullVersion.MinorRevision) then
165 |         failwith
166 |             "something is wrong, this script should tag only even(stable) minorRevisions, not odd(unstable) ones"
167 | 
168 |     Process.Execute(
169 |         {
170 |             Command = "git"
171 |             Arguments = sprintf "tag --delete %s" (newFullVersion.ToString())
172 |         },
173 |         Echo.Off
174 |     )
175 |     |> ignore
176 | 
177 |     Process
178 |         .Execute(
179 |             {
180 |                 Command = "git"
181 |                 Arguments = sprintf "tag %s" (newFullVersion.ToString())
182 |             },
183 |             Echo.Off
184 |         )
185 |         .UnwrapDefault()
186 |     |> ignore<string>
187 | 
188 | Console.WriteLine "Bumping..."
189 | let fullUnstableVersion, newFullStableVersion = Bump true
190 | GitCommit fullUnstableVersion newFullStableVersion
191 | GitTag newFullStableVersion
192 | 
193 | Console.WriteLine(
194 |     sprintf
195 |         "Version bumped to %s, release binaries now (via ./snap_release.sh on another tab) and press a key here when you finish."
196 |         (newFullStableVersion.ToString())
197 | )
198 | 
199 | Console.Read() |> ignore
200 | 
201 | Console.WriteLine "Post-bumping..."
202 | let fullStableVersion, newFullUnstableVersion = Bump false
203 | GitCommit fullStableVersion newFullUnstableVersion
204 | 
205 | Console.WriteLine(
206 |     sprintf
207 |         "Version bumping finished. Remember to push via `git push <remote> <branch> %s`"
208 |         (newFullStableVersion.ToString())
209 | )
210 | 


--------------------------------------------------------------------------------
/Tools/rename.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env -S dotnet fsi
  2 | 
  3 | open System
  4 | open System.IO
  5 | 
  6 | #if LEGACY_FRAMEWORK
  7 | Console.Error.WriteLine "This script is only compatible with .NET6 or higher"
  8 | Environment.Exit 1
  9 | #else
 10 | 
 11 | #load "../Fsdk/Misc.fs"
 12 | open Fsdk
 13 | 
 14 | let args = Misc.FsxOnlyArguments()
 15 | 
 16 | if args.Length > 1 then
 17 |     Console.Error.WriteLine
 18 |         "Can only pass one argument: --force (for when deciding not to do a dry-run)"
 19 | 
 20 |     Environment.Exit 1
 21 | 
 22 | let dryRun =
 23 |     if args.Length = 0 then
 24 |         Console.WriteLine "No arguments detected, performing dry-run"
 25 |         true
 26 |     else if args.[0] <> "--force" then
 27 |         Console.Error.WriteLine
 28 |             "Can only pass one flag: --force (for when deciding not to do a dry-run)"
 29 | 
 30 |         Environment.Exit 2
 31 |         failwith "Unreachable"
 32 |     else
 33 |         false
 34 | 
 35 | let currentDir = Directory.GetCurrentDirectory() |> DirectoryInfo
 36 | 
 37 | let illegalCharsInExFat =
 38 |     [
 39 |         '\\'
 40 |         '/'
 41 |         '*'
 42 |         '?'
 43 |         '"'
 44 |         '<'
 45 |         '>'
 46 |         '|'
 47 |     ]
 48 | 
 49 | let CheckTimes(filesAndSubDirs: seq<FileSystemInfo>) =
 50 |     let exFatEarliestAllowedTime = DateTime(1980, 1, 1, 0, 0, 0)
 51 | 
 52 |     let checkTimeStampIsCorrect (entry: FileSystemInfo) (date: DateTime) =
 53 |         let nugetMagicFolderMagicDate = DateTime(1979, 12, 31, 16, 0, 0)
 54 | 
 55 |         if date.ToUniversalTime() <> nugetMagicFolderMagicDate
 56 |            && date < exFatEarliestAllowedTime then
 57 |             if dryRun then
 58 |                 Console.Error.WriteLine(
 59 |                     sprintf
 60 |                         "Illegal timestamp (for exFAT) found in %s"
 61 |                         entry.FullName
 62 |                 )
 63 | 
 64 |                 true
 65 |             else
 66 |                 false
 67 |         else
 68 |             true
 69 | 
 70 |     for entry in filesAndSubDirs do
 71 |         if not(checkTimeStampIsCorrect entry entry.CreationTime) then
 72 |             entry.CreationTime <- exFatEarliestAllowedTime
 73 | 
 74 |         if not(checkTimeStampIsCorrect entry entry.CreationTimeUtc) then
 75 |             entry.CreationTimeUtc <- exFatEarliestAllowedTime
 76 | 
 77 |         if not(checkTimeStampIsCorrect entry entry.LastAccessTime) then
 78 |             entry.LastAccessTime <- exFatEarliestAllowedTime
 79 | 
 80 |         if not(checkTimeStampIsCorrect entry entry.LastAccessTimeUtc) then
 81 |             entry.LastAccessTimeUtc <- exFatEarliestAllowedTime
 82 | 
 83 |         if not(checkTimeStampIsCorrect entry entry.LastWriteTime) then
 84 |             entry.LastWriteTime <- exFatEarliestAllowedTime
 85 | 
 86 |         if not(checkTimeStampIsCorrect entry entry.LastWriteTimeUtc) then
 87 |             entry.LastWriteTimeUtc <- exFatEarliestAllowedTime
 88 | 
 89 | let CheckNames(filesAndSubDirs: seq<FileSystemInfo>) =
 90 |     let rec addToMap
 91 |         (entries: seq<FileSystemInfo>)
 92 |         (accMap: Map<string, seq<FileSystemInfo>>)
 93 |         : Map<string, seq<FileSystemInfo>> =
 94 |         match Seq.tryHead entries with
 95 |         | None -> accMap
 96 |         | Some head ->
 97 |             let keyForEntry = head.Name.ToLower()
 98 | 
 99 |             let newMap =
100 |                 match Map.tryFind keyForEntry accMap with
101 |                 | None -> Map.add keyForEntry (Seq.singleton head) accMap
102 |                 | Some existingEntries ->
103 |                     Map.add
104 |                         keyForEntry
105 |                         (Seq.append existingEntries (Seq.singleton head))
106 |                         accMap
107 | 
108 |             addToMap (Seq.tail entries) newMap
109 | 
110 |     let namesMap = addToMap filesAndSubDirs Map.empty
111 | 
112 |     for KeyValue(_key, value) in namesMap do
113 |         match Seq.length value with
114 |         | 1 -> ()
115 |         | 0 -> failwith "Something went wrong..."
116 |         | _ ->
117 |             Console.Error.WriteLine
118 |                 "Some file system entries were found whose name only differs in case (illegal in exFAT):"
119 | 
120 |             for entry in value do
121 |                 Console.Error.WriteLine("* " + entry.FullName)
122 | 
123 |             Console.Error.WriteLine()
124 | 
125 | let CheckName (fileOrDirName: string) (fullName: string) =
126 |     for illegalChar in illegalCharsInExFat do
127 |         if fileOrDirName.Contains illegalChar then
128 |             Console.WriteLine(
129 |                 sprintf "Illegal char (for exFAT) found in %s" fullName
130 |             )
131 | 
132 |     let allChars: seq<char> = fileOrDirName
133 | 
134 |     if not(Seq.forall (fun (aChar: char) -> Char.IsAscii aChar) allChars) then
135 |         Console.WriteLine(
136 |             sprintf "Illegal char (nonASCII) found in %s" fullName
137 |         )
138 | 
139 | let rec Rename(dir: DirectoryInfo) : unit =
140 |     let Separate
141 |         (entries: seq<FileSystemInfo>)
142 |         : seq<DirectoryInfo> * seq<FileInfo> =
143 |         let dirs =
144 |             seq {
145 |                 for entry in entries do
146 |                     if Directory.Exists entry.FullName then
147 |                         yield DirectoryInfo entry.FullName
148 |             }
149 | 
150 |         let files =
151 |             seq {
152 |                 for entry in entries do
153 |                     if File.Exists entry.FullName then
154 |                         yield FileInfo entry.FullName
155 |             }
156 | 
157 |         dirs, files
158 | 
159 |     CheckName dir.Name dir.FullName
160 | 
161 |     let allEntries = dir.EnumerateFileSystemInfos()
162 | 
163 |     let subDirs, files = Separate allEntries
164 | 
165 |     CheckNames allEntries
166 | 
167 |     CheckTimes allEntries
168 | 
169 |     for subDir in subDirs do
170 |         if not(isNull subDir.LinkTarget) then
171 |             Console.WriteLine(
172 |                 sprintf
173 |                     "Skipping link %s (if using robocopy, exclude them via /xj)"
174 |                     subDir.FullName
175 |             )
176 |         else
177 |             Rename subDir
178 | 
179 |     for file in files do
180 |         CheckName file.Name file.FullName
181 | 
182 | try
183 |     Rename currentDir
184 | with
185 | | :? UnauthorizedAccessException ->
186 |     Console.Error.WriteLine
187 |         "Encountered an access-denied error, did you run with root/Administrator privileges?"
188 | 
189 |     exit 3
190 | #endif
191 | 


--------------------------------------------------------------------------------
/fsx/Program.fs:
--------------------------------------------------------------------------------
  1 | // this script is the equivalent of unixy launcher.sh script but for windows (where we're sure a FSI exists)
  2 | 
  3 | open System
  4 | open System.IO
  5 | open System.Text
  6 | open System.Linq
  7 | open System.Diagnostics
  8 | 
  9 | open Fsdk
 10 | open Fsdk.Misc
 11 | open Fsdk.Process
 12 | open FSX.Compiler
 13 | 
 14 | type FsxScriptDiscoveryInfo =
 15 |     | FsxFsxNotFoundYet
 16 |     | FsxFsxFoundButNoFsxScriptFoundYet
 17 |     | FsxFsxFoundAndFsxScriptNameSupplied of _userScriptName: string
 18 | 
 19 | let assemblyExecutableExtension =
 20 | #if !LEGACY_FRAMEWORK
 21 |     "dll"
 22 | #else
 23 |     "exe"
 24 | #endif
 25 | 
 26 | 
 27 | let SplitArgsIntoFsxcArgsAndUserArgs
 28 |     ()
 29 |     : seq<string> * Option<string> * seq<string> =
 30 |     let rec userArgsInternal
 31 |         (fsxScriptDiscoverySoFar: FsxScriptDiscoveryInfo)
 32 |         (fsxcArgsSoFar: List<string>)
 33 |         (userArgsSoFar: List<string>)
 34 |         (nextArgs: List<string>)
 35 |         : seq<string> * Option<string> * seq<string> =
 36 |         match nextArgs, fsxScriptDiscoverySoFar with
 37 |         | [], FsxFsxFoundAndFsxScriptNameSupplied userScriptName ->
 38 |             let finalFscxArgs = fsxcArgsSoFar |> List.rev |> Seq.ofList
 39 |             let finalUserArgs = userArgsSoFar |> List.rev |> Seq.ofList
 40 |             finalFscxArgs, Some userScriptName, finalUserArgs
 41 |         | [], FsxFsxFoundButNoFsxScriptFoundYet ->
 42 |             let finalFscxArgs = fsxcArgsSoFar |> List.rev |> Seq.ofList
 43 |             let finalUserArgs = userArgsSoFar |> List.rev |> Seq.ofList
 44 |             finalFscxArgs, None, finalUserArgs
 45 |         | [], FsxFsxNotFoundYet ->
 46 |             failwith(sprintf "fsx.%s not found" assemblyExecutableExtension)
 47 |         | head :: tail, fsxScriptDiscoverySoFar ->
 48 |             match fsxScriptDiscoverySoFar, head with
 49 |             | FsxFsxNotFoundYet, arg when
 50 |                 arg.Split(Path.DirectorySeparatorChar).Last()
 51 |                     .EndsWith(sprintf "fsx.%s" assemblyExecutableExtension)
 52 |                 ->
 53 |                 if not fsxcArgsSoFar.IsEmpty then
 54 |                     failwith
 55 |                         "no fsxc args should have been added yet if FsxFsxNotFoundYet"
 56 | 
 57 |                 if not userArgsSoFar.IsEmpty then
 58 |                     failwith
 59 |                         "no fsxc args should have been added yet if FsxFsxNotFoundYet"
 60 | 
 61 |                 userArgsInternal
 62 |                     FsxFsxFoundButNoFsxScriptFoundYet
 63 |                     List.Empty
 64 |                     List.Empty
 65 |                     tail
 66 |             | FsxFsxNotFoundYet, _likelyFsiExePath ->
 67 |                 if not fsxcArgsSoFar.IsEmpty then
 68 |                     failwith
 69 |                         "no fsxc args should have been added yet if FsxFsxNotFoundYet"
 70 | 
 71 |                 if not userArgsSoFar.IsEmpty then
 72 |                     failwith
 73 |                         "no fsxc args should have been added yet if FsxFsxNotFoundYet"
 74 | 
 75 |                 userArgsInternal FsxFsxNotFoundYet List.empty List.Empty tail
 76 |             | FsxFsxFoundButNoFsxScriptFoundYet, arg when
 77 |                 arg
 78 |                     .Split(Path.DirectorySeparatorChar)
 79 |                     .Last()
 80 |                     .EndsWith ".fsx"
 81 |                 ->
 82 |                 if not userArgsSoFar.IsEmpty then
 83 |                     failwith
 84 |                         "no fsxc args should have been added yet if FsxFsxNotFoundYet"
 85 | 
 86 |                 userArgsInternal
 87 |                     (FsxFsxFoundAndFsxScriptNameSupplied arg)
 88 |                     fsxcArgsSoFar
 89 |                     List.empty
 90 |                     tail
 91 |             | FsxFsxFoundButNoFsxScriptFoundYet, fsxcArg ->
 92 |                 if not userArgsSoFar.IsEmpty then
 93 |                     failwith
 94 |                         "no fsxc args should have been added yet if FsxFsxFoundButNoFsxScriptFoundYet"
 95 | 
 96 |                 userArgsInternal
 97 |                     FsxFsxFoundButNoFsxScriptFoundYet
 98 |                     (fsxcArg :: fsxcArgsSoFar)
 99 |                     List.empty
100 |                     tail
101 |             | (FsxFsxFoundAndFsxScriptNameSupplied userScriptName), userArg ->
102 |                 userArgsInternal
103 |                     (FsxFsxFoundAndFsxScriptNameSupplied userScriptName)
104 |                     fsxcArgsSoFar
105 |                     (userArg :: userArgsSoFar)
106 |                     tail
107 | 
108 | 
109 |     Environment.GetCommandLineArgs()
110 |     |> List.ofArray
111 |     |> userArgsInternal FsxFsxNotFoundYet List.empty List.empty
112 | 
113 | let InjectBinSubfolderInPath(userScriptPath: string) =
114 |     if not(userScriptPath.EndsWith ".fsx") then
115 |         failwithf "Assertion failed: %s should end with .fsx" userScriptPath
116 | 
117 |     let binPath =
118 |         match userScriptPath.LastIndexOf Path.DirectorySeparatorChar with
119 |         | index when index >= 0 ->
120 |             let path = userScriptPath.Substring(0, index)
121 | 
122 |             sprintf
123 |                 "%s%sbin%s%s.exe"
124 |                 path
125 |                 (Path.DirectorySeparatorChar.ToString())
126 |                 (Path.DirectorySeparatorChar.ToString())
127 |                 (Path.GetFileName userScriptPath)
128 |         | _ ->
129 |             sprintf
130 |                 "bin%s%s.exe"
131 |                 (Path.DirectorySeparatorChar.ToString())
132 |                 (Path.GetFileName userScriptPath)
133 | 
134 |     FileInfo binPath
135 | 
136 | let fsxcArgs, maybeUserScriptPath, userArgs = SplitArgsIntoFsxcArgsAndUserArgs()
137 | 
138 | let fsxcMainArguments =
139 |     match maybeUserScriptPath with
140 |     | Some userScriptPath ->
141 |         Seq.append fsxcArgs (Seq.singleton userScriptPath) |> Seq.toArray
142 |     | None -> fsxcArgs |> Seq.toArray
143 | 
144 | Program.OuterMain fsxcMainArguments |> ignore
145 | 
146 | match maybeUserScriptPath with
147 | | None ->
148 |     failwith(
149 |         "Compilation of anything that is not an .fsx should have been rejected by fsx"
150 |         + " and shouldn't have reached this point. Please report this bug."
151 |     )
152 | | _ -> ()
153 | 
154 | let finalLaunch =
155 |     {
156 |         Command =
157 |             (InjectBinSubfolderInPath maybeUserScriptPath.Value)
158 |                 .FullName
159 |         Arguments = String.Join(" ", userArgs)
160 |     }
161 | 
162 | let finalProc = Process.Execute(finalLaunch, Echo.OutputOnly)
163 | // FIXME: fsx being an F# project instead of a launcher script means that, on
164 | // Windows (and in Unix when installed via 'dotnet tool install fsx'), fsx will be running the user script as
165 | // child process, which may make the memory gains of using fsx instead of fsi/fsharpi
166 | // (as explained in the ReadMe.md file) not as prominent (while in Unix, i.e. Linux and macOS, when the
167 | // tool is not installed via `dotnet tool install fsx`, they still are what ReadMe.md claims because we use a
168 | // bash script which uses 'exec') // TODO: measure measure!
169 | match finalProc.Result with
170 | | Error(exitCode, _errOutput) -> Environment.Exit exitCode
171 | | _ -> Environment.Exit 0
172 | 


--------------------------------------------------------------------------------
/Tools/nugetPush.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env fsharpi
  2 | 
  3 | open System
  4 | open System.IO
  5 | open System.Linq
  6 | 
  7 | #r "System.Configuration"
  8 | open System.Configuration
  9 | 
 10 | #load "../Fsdk/Misc.fs"
 11 | #load "../Fsdk/Process.fs"
 12 | #load "../Fsdk/Git.fs"
 13 | #load "../Fsdk/Network.fs"
 14 | 
 15 | open Fsdk
 16 | open Fsdk.Process
 17 | 
 18 | let PrintUsage() =
 19 |     Console.Error.WriteLine
 20 |         "Usage: nugetPush.fsx [--output-version] [baseVersion] <nugetApiKey>"
 21 | 
 22 |     Environment.Exit 1
 23 | 
 24 | let args = Misc.FsxOnlyArguments()
 25 | 
 26 | if args.Length > 3 then
 27 |     PrintUsage()
 28 | 
 29 | if args.Length > 2 && args.[0] <> "--output-version" then
 30 |     PrintUsage()
 31 | 
 32 | let currentDir = Directory.GetCurrentDirectory() |> DirectoryInfo
 33 | 
 34 | let IsDotNetSdkInstalled() =
 35 |     try
 36 |         let dotnetVersionCmd =
 37 |             {
 38 |                 Command = "dotnet"
 39 |                 Arguments = "--version"
 40 |             }
 41 | 
 42 |         Process
 43 |             .Execute(dotnetVersionCmd, Echo.All)
 44 |             .UnwrapDefault()
 45 |         |> ignore<string>
 46 | 
 47 |         true
 48 |     with
 49 |     | :? ProcessCouldNotStart -> false
 50 | 
 51 | let EnsureNugetExists() =
 52 |     let nugetTargetDir =
 53 |         Path.Combine(currentDir.FullName, ".nuget") |> DirectoryInfo
 54 | 
 55 |     if not nugetTargetDir.Exists then
 56 |         nugetTargetDir.Create()
 57 | 
 58 |     let prevCurrentDir = Directory.GetCurrentDirectory()
 59 |     Directory.SetCurrentDirectory nugetTargetDir.FullName
 60 | 
 61 |     let nugetDownloadUri =
 62 |         Uri "https://dist.nuget.org/win-x86-commandline/v4.5.1/nuget.exe"
 63 | 
 64 |     Network.DownloadFile nugetDownloadUri
 65 |     |> Async.RunSynchronously
 66 |     |> ignore<FileInfo>
 67 | 
 68 |     let nugetExe =
 69 |         Path.Combine(nugetTargetDir.FullName, "nuget.exe") |> FileInfo
 70 | 
 71 |     Directory.SetCurrentDirectory prevCurrentDir
 72 | 
 73 |     nugetExe
 74 | 
 75 | let FindOrGenerateNugetPackages() : seq<FileInfo> =
 76 |     let nuspecFiles = currentDir.EnumerateFiles "*.nuspec"
 77 | 
 78 |     if nuspecFiles.Any() then
 79 |         if args.Length < 1 then
 80 |             Console.Error.WriteLine
 81 |                 "Usage: nugetPush.fsx [baseVersion] <nugetApiKey>"
 82 | 
 83 |             Environment.Exit 1
 84 | 
 85 |         let baseVersion = args.First()
 86 | 
 87 |         seq {
 88 |             for nuspecFile in nuspecFiles do
 89 |                 let packageName =
 90 |                     Path.GetFileNameWithoutExtension nuspecFile.FullName
 91 | 
 92 |                 let nugetVersion =
 93 |                     Network.GetNugetPrereleaseVersionFromBaseVersion baseVersion
 94 | 
 95 |                 // we need to download nuget.exe here because `dotnet pack` doesn't support using standalone (i.e.
 96 |                 // without a project association) .nuspec files, see https://github.com/NuGet/Home/issues/4254
 97 | 
 98 |                 let nugetPackCmd =
 99 |                     {
100 |                         Command = EnsureNugetExists().FullName
101 |                         Arguments =
102 |                             sprintf
103 |                                 "pack %s -Version %s"
104 |                                 nuspecFile.FullName
105 |                                 nugetVersion
106 |                     }
107 | 
108 |                 Process
109 |                     .Execute(nugetPackCmd, Echo.All)
110 |                     .UnwrapDefault()
111 |                 |> ignore<string>
112 | 
113 |                 yield FileInfo(sprintf "%s.%s.nupkg" packageName nugetVersion)
114 |         }
115 |     else
116 |         let FindNugetPackages() =
117 |             currentDir.Refresh()
118 |             currentDir.EnumerateFiles("*.nupkg", SearchOption.AllDirectories)
119 | 
120 |         if not(FindNugetPackages().Any()) then
121 |             if args.Length < 1 then
122 |                 Console.Error.WriteLine
123 |                     "Usage: nugetPush.fsx [baseVersion] <nugetApiKey>"
124 | 
125 |                 Environment.Exit 1
126 | 
127 |             let baseVersion = args.First()
128 | 
129 |             let nugetVersion =
130 |                 Network.GetNugetPrereleaseVersionFromBaseVersion baseVersion
131 | 
132 |             if IsDotNetSdkInstalled() then
133 |                 let dotnetPackCmd =
134 |                     {
135 |                         Command = "dotnet"
136 |                         Arguments =
137 |                             sprintf
138 |                                 "pack --configuration Release -p:Version=%s"
139 |                                 nugetVersion
140 |                     }
141 | 
142 |                 Process
143 |                     .Execute(dotnetPackCmd, Echo.All)
144 |                     .UnwrapDefault()
145 |                 |> ignore<string>
146 |             else
147 |                 failwith
148 |                     "Please install .NET SDK to build nuget packages without nuspec file"
149 | 
150 |         FindNugetPackages()
151 | 
152 | 
153 | let NugetUpload (packageFile: FileInfo) (nugetApiKey: string) =
154 | 
155 |     let defaultNugetFeedUrl = "https://api.nuget.org/v3/index.json"
156 | 
157 |     if IsDotNetSdkInstalled() then
158 |         let nugetPushCmd =
159 |             {
160 |                 Command = "dotnet"
161 |                 Arguments =
162 |                     sprintf
163 |                         "nuget push %s -k %s -s %s"
164 |                         packageFile.FullName
165 |                         nugetApiKey
166 |                         defaultNugetFeedUrl
167 |             }
168 | 
169 |         Process
170 |             .Execute(nugetPushCmd, Echo.All)
171 |             .UnwrapDefault()
172 |         |> ignore<string>
173 |     else
174 |         let nugetPushCmd =
175 |             {
176 |                 Command = EnsureNugetExists().FullName
177 |                 Arguments =
178 |                     sprintf
179 |                         "push %s -ApiKey %s -Source %s"
180 |                         packageFile.FullName
181 |                         nugetApiKey
182 |                         defaultNugetFeedUrl
183 |             }
184 | 
185 |         Process
186 |             .Execute(nugetPushCmd, Echo.All)
187 |             .UnwrapDefault()
188 |         |> ignore<string>
189 | 
190 | if args.Length > 0 && args.[0] = "--output-version" then
191 |     if args.Length < 2 then
192 |         Console.Error.WriteLine
193 |             "When using --output-version, pass the base version as the second argument"
194 | 
195 |         Environment.Exit 4
196 | 
197 |     let baseVersion = args.[1]
198 | 
199 |     Console.WriteLine(
200 |         Network.GetNugetPrereleaseVersionFromBaseVersion baseVersion
201 |     )
202 | 
203 |     Environment.Exit 0
204 | 
205 | let nugetPkgs = FindOrGenerateNugetPackages() |> List.ofSeq
206 | 
207 | if not(nugetPkgs.Any()) then
208 |     Console.Error.WriteLine "No nuget packages found or generated"
209 |     Environment.Exit 3
210 | 
211 | if args.Length < 1 then
212 |     Console.Error.WriteLine
213 |         "nugetApiKey argument was not passed to the script (running in a fork?), skipping upload..."
214 | 
215 |     Environment.Exit 0
216 | 
217 | let nugetApiKey = args.Last()
218 | 
219 | let GetCurrentRef() : string =
220 |     let githubRef = Environment.GetEnvironmentVariable "GITHUB_REF"
221 |     // https://docs.gitlab.com/ee/ci/variables/predefined_variables.html
222 |     let gitlabRef = Environment.GetEnvironmentVariable "CI_COMMIT_REF_NAME"
223 | 
224 |     if githubRef <> null then
225 |         githubRef
226 |     elif gitlabRef <> null then
227 |         gitlabRef
228 |     else
229 |         Git.GetCurrentBranch()
230 | 
231 | let IsMasterBranch() : bool =
232 |     let branch = GetCurrentRef()
233 |     branch = "master" || branch = "refs/heads/master"
234 | 
235 | let IsDefaultRefToPush() : bool =
236 |     let defaultRefToPushOpt =
237 |         Environment.GetEnvironmentVariable "DEFAULT_REF_TO_NUGET_PUSH"
238 |         |> Option.ofObj
239 | 
240 |     match defaultRefToPushOpt with
241 |     | Some defaultRefToPush ->
242 |         if (defaultRefToPush.StartsWith "*") && (defaultRefToPush.EndsWith "*") then
243 |             let defaultRefWithoutWildCard =
244 |                 defaultRefToPush.Substring(1, defaultRefToPush.Count() - 2)
245 | 
246 |             GetCurrentRef().Contains defaultRefWithoutWildCard
247 |         else
248 |             GetCurrentRef() = defaultRefToPush
249 |     | None -> IsMasterBranch()
250 | 
251 | if not(IsDefaultRefToPush()) then
252 |     Console.WriteLine "Branch is not default branch to push, skipping upload..."
253 |     Environment.Exit 0
254 | 
255 | for nugetPkg in nugetPkgs do
256 |     NugetUpload nugetPkg nugetApiKey
257 | 


--------------------------------------------------------------------------------
/scripts/make.fsx:
--------------------------------------------------------------------------------
  1 | open System
  2 | open System.IO
  3 | open System.Net
  4 | open System.Linq
  5 | open System.Diagnostics
  6 | 
  7 | #r "System.Configuration"
  8 | open System.Configuration
  9 | 
 10 | #load "../Fsdk/Misc.fs"
 11 | #load "../Fsdk/Process.fs"
 12 | #load "../Fsdk/Git.fs"
 13 | #load "../Fsdk/Network.fs"
 14 | 
 15 | open Fsdk
 16 | open Fsdk.Process
 17 | 
 18 | let ScriptsDir = __SOURCE_DIRECTORY__ |> DirectoryInfo
 19 | let RootDir = Path.Combine(ScriptsDir.FullName, "..") |> DirectoryInfo
 20 | let TestDir = Path.Combine(RootDir.FullName, "test") |> DirectoryInfo
 21 | let ToolsDir = Path.Combine(RootDir.FullName, "Tools") |> DirectoryInfo
 22 | let FsdkDir = Path.Combine(RootDir.FullName, "Fsdk") |> DirectoryInfo
 23 | let NugetDir = Path.Combine(RootDir.FullName, ".nuget") |> DirectoryInfo
 24 | let NugetExe = Path.Combine(NugetDir.FullName, "nuget.exe") |> FileInfo
 25 | 
 26 | type BinaryConfig =
 27 |     | Debug
 28 |     | Release
 29 | 
 30 |     override self.ToString() =
 31 |         sprintf "%A" self
 32 | 
 33 | let GatherTarget(args: List<string>) : Option<string> =
 34 |     let rec gatherTarget
 35 |         (args: List<string>)
 36 |         (targetSet: Option<string>)
 37 |         : Option<string> =
 38 |         match args with
 39 |         | [] -> targetSet
 40 |         | head :: tail ->
 41 |             if targetSet.IsSome then
 42 |                 failwith "only one target can be passed to make"
 43 | 
 44 |             gatherTarget tail (Some head)
 45 | 
 46 |     gatherTarget args None
 47 | 
 48 | let mainBinariesDir binaryConfig =
 49 | #if !LEGACY_FRAMEWORK
 50 |     Path.Combine(
 51 |         RootDir.FullName,
 52 |         "fsxc",
 53 |         "bin",
 54 |         binaryConfig.ToString(),
 55 |         "net6.0"
 56 |     )
 57 | #else
 58 |     Path.Combine(RootDir.FullName, "fsxc", "bin", binaryConfig.ToString())
 59 | #endif
 60 |     |> DirectoryInfo
 61 | 
 62 | #if LEGACY_FRAMEWORK
 63 | let PrintNugetVersion() =
 64 |     if not NugetExe.Exists then
 65 |         false
 66 |     else
 67 |         let nugetProc =
 68 |             Network.RunNugetCommand NugetExe String.Empty Echo.OutputOnly false
 69 | 
 70 |         match nugetProc.Result with
 71 |         | ProcessResultState.Success _ -> true
 72 |         | ProcessResultState.WarningsOrAmbiguous _output ->
 73 |             Console.WriteLine()
 74 |             Console.Out.Flush()
 75 | 
 76 |             failwith
 77 |                 "nuget process succeeded but the output contained warnings ^"
 78 |         | ProcessResultState.Error(_exitCode, _output) ->
 79 |             Console.WriteLine()
 80 |             Console.Out.Flush()
 81 |             failwith "nuget process' output contained errors ^"
 82 | #endif
 83 | 
 84 | let FindBuildTool() : string * string =
 85 |     match Misc.GuessPlatform() with
 86 |     | Misc.Platform.Linux
 87 |     | Misc.Platform.Mac ->
 88 |         failwith
 89 |             "cannot find buildTool because this script is not ready for Unix yet"
 90 |     | Misc.Platform.Windows ->
 91 | #if !LEGACY_FRAMEWORK
 92 |         "dotnet", "build"
 93 | #else
 94 |         match Process.VsWhere "MSBuild\\**\\Bin\\MSBuild.exe" with
 95 |         | None -> failwith "msbuild not found?"
 96 |         | Some msbuildExe -> msbuildExe, String.Empty
 97 | #endif
 98 | 
 99 | let BuildSolution
100 |     (buildTool: string * string)
101 |     (solutionFileName: string)
102 |     (binaryConfig: BinaryConfig)
103 |     (extraOptions: string)
104 |     =
105 |     let configOption = sprintf "/p:Configuration=%s" (binaryConfig.ToString())
106 | 
107 |     let buildToolExecutable, buildToolArg = buildTool
108 | 
109 |     let buildArgs =
110 |         sprintf
111 |             "%s %s %s %s"
112 |             buildToolArg
113 |             solutionFileName
114 |             configOption
115 |             extraOptions
116 | 
117 |     let buildProcess =
118 |         Process.Execute(
119 |             {
120 |                 Command = buildToolExecutable
121 |                 Arguments = buildArgs
122 |             },
123 |             Echo.All
124 |         )
125 | 
126 |     match buildProcess.Result with
127 |     | Error _ ->
128 |         Console.WriteLine()
129 |         Console.Out.Flush()
130 | 
131 |         Console.Error.WriteLine(
132 |             sprintf
133 |                 "Build failed with build tool '%s %s' ^"
134 |                 buildToolExecutable
135 |                 buildToolArg
136 |         )
137 | 
138 | #if LEGACY_FRAMEWORK
139 |         PrintNugetVersion() |> ignore
140 | #endif
141 |         Environment.Exit 1
142 |     | _ -> ()
143 | 
144 | let JustBuild binaryConfig =
145 | #if !LEGACY_FRAMEWORK
146 |     let solFile = "fsx.sln"
147 | 
148 |     Process
149 |         .Execute(
150 |             {
151 |                 Command = "dotnet"
152 |                 Arguments = sprintf "restore %s" solFile
153 |             },
154 |             Echo.All
155 |         )
156 |         .UnwrapDefault()
157 |     |> ignore<string>
158 | #else
159 |     let solFile = "fsx-legacy.sln"
160 | 
161 |     Network.RunNugetCommand
162 |         NugetExe
163 |         (sprintf "restore %s" solFile)
164 |         Echo.All
165 |         true
166 |     |> ignore
167 | #endif
168 | 
169 | 
170 |     let buildTool = FindBuildTool()
171 | 
172 |     Console.WriteLine(
173 |         sprintf "Building in %s mode..." (binaryConfig.ToString())
174 |     )
175 | 
176 |     BuildSolution buildTool solFile binaryConfig String.Empty
177 | 
178 | let MakeAll() =
179 |     let buildConfig = BinaryConfig.Debug
180 |     JustBuild buildConfig
181 |     buildConfig
182 | 
183 | let programFiles =
184 |     Environment.GetEnvironmentVariable "ProgramW6432" |> DirectoryInfo
185 | 
186 | let fsxInstallationDir =
187 |     Path.Combine(programFiles.FullName, "fsx") |> DirectoryInfo
188 | 
189 | #if !LEGACY_FRAMEWORK
190 | let fsxBat = Path.Combine(ScriptsDir.FullName, "fsx.bat") |> FileInfo
191 | 
192 | let fsxBatDestination =
193 |     Path.Combine(fsxInstallationDir.FullName, "fsx.bat") |> FileInfo
194 | 
195 | let fsxInstalledExecutable = fsxBatDestination
196 | #else
197 | let fsxExeDestination =
198 |     Path.Combine(fsxInstallationDir.FullName, "fsx.exe") |> FileInfo
199 | 
200 | let fsxInstalledExecutable = fsxExeDestination
201 | #endif
202 | 
203 | let maybeTarget = GatherTarget(Misc.FsxOnlyArguments())
204 | 
205 | let assemblyExecutableExtension =
206 | #if !LEGACY_FRAMEWORK
207 |     "dll"
208 | #else
209 |     "exe"
210 | #endif
211 | 
212 | let releaseFolderPath = Path.Combine(RootDir.FullName, "fsx", "bin", "Release")
213 | 
214 | #if !LEGACY_FRAMEWORK
215 | let finalReleaseFolderPath = Path.Combine(releaseFolderPath, "net6.0")
216 | #else
217 | let finalReleaseFolderPath = releaseFolderPath
218 | #endif
219 | 
220 | let Install(isReinstall: bool) =
221 |     let buildConfig = BinaryConfig.Release
222 |     JustBuild buildConfig
223 | 
224 |     if fsxInstallationDir.Exists then
225 |         if not isReinstall then
226 |             failwithf
227 |                 "Existing installation found in '%s'. Consider using the target 'reinstall' instead of 'install'."
228 |                 fsxInstallationDir.FullName
229 |         else
230 |             fsxInstallationDir.Delete true
231 | 
232 |     Console.WriteLine "Installing..."
233 |     Console.WriteLine()
234 | 
235 |     Misc.CopyDirectoryRecursively(
236 |         mainBinariesDir buildConfig,
237 |         fsxInstallationDir,
238 |         List.Empty
239 |     )
240 | 
241 |     let fsxLauncher =
242 |         Path.Combine(
243 |             finalReleaseFolderPath,
244 |             sprintf "fsx.%s" assemblyExecutableExtension
245 |         )
246 |         |> FileInfo
247 | 
248 |     File.Copy(
249 |         fsxLauncher.FullName,
250 |         Path.Combine(
251 |             fsxInstallationDir.FullName,
252 |             sprintf "fsx.%s" assemblyExecutableExtension
253 |         )
254 |     )
255 | 
256 | #if !LEGACY_FRAMEWORK
257 |     File.Copy(
258 |         Path.Combine(finalReleaseFolderPath, "fsx.runtimeconfig.json"),
259 |         Path.Combine(fsxInstallationDir.FullName, "fsx.runtimeconfig.json")
260 |     )
261 | 
262 |     File.Copy(fsxBat.FullName, fsxBatDestination.FullName)
263 | #endif
264 | 
265 |     let fsdkInstallDir =
266 |         Path.Combine(fsxInstallationDir.FullName, "Fsdk") |> DirectoryInfo
267 | 
268 |     if not fsdkInstallDir.Exists then
269 |         Directory.CreateDirectory fsdkInstallDir.FullName
270 |         |> ignore<DirectoryInfo>
271 | 
272 |     let miscFs = Path.Combine(FsdkDir.FullName, "Misc.fs") |> FileInfo
273 | 
274 |     let miscFsTarget =
275 |         Path.Combine(fsdkInstallDir.FullName, "Misc.fs") |> FileInfo
276 | 
277 |     File.Copy(miscFs.FullName, miscFsTarget.FullName)
278 |     let processFs = Path.Combine(FsdkDir.FullName, "Process.fs") |> FileInfo
279 | 
280 |     let processFsTarget =
281 |         Path.Combine(fsdkInstallDir.FullName, "Process.fs") |> FileInfo
282 | 
283 |     File.Copy(processFs.FullName, processFsTarget.FullName)
284 | 
285 | 
286 |     // FIXME: the below way of installing fsx into PATH env var seems to work, but somehow cannot be
287 |     // tested inside CI, because `ConfigCommandCheck(List.singleton "fsx.bat")` fails, even though
288 |     // Environment.GetEnvironmentVariable(pathEnvVarName, envVarScope) contains the new path (even
289 |     // when testing this inside a different Makefile target -> "check")
290 |     let pathEnvVarName = "PATH"
291 |     let envVarScope = EnvironmentVariableTarget.Machine
292 | 
293 |     let currentPaths =
294 |         Environment.GetEnvironmentVariable(pathEnvVarName, envVarScope)
295 | 
296 |     if not(currentPaths.Contains fsxInstallationDir.FullName) then
297 |         let newPathEnvVar =
298 |             sprintf
299 |                 "%s%c%s"
300 |                 fsxInstallationDir.FullName
301 |                 Path.PathSeparator
302 |                 currentPaths
303 | 
304 |         Environment.SetEnvironmentVariable(
305 |             pathEnvVarName,
306 |             newPathEnvVar,
307 |             envVarScope
308 |         )
309 | 
310 | 
311 | 
312 |     Console.WriteLine(
313 |         sprintf "Successfully installed in %s" fsxInstallationDir.FullName
314 |     )
315 | 
316 | match maybeTarget with
317 | 
318 | | None
319 | | Some "all" -> MakeAll() |> ignore
320 | 
321 | | Some "release" ->
322 |     let buildConfig = BinaryConfig.Release
323 |     JustBuild buildConfig
324 | 
325 | | Some "reinstall" -> Install true
326 | 
327 | | Some "install" -> Install false
328 | 
329 | | Some "check" ->
330 | 
331 |     // FIXME: contributor should be able to run 'make check' before 'make install'
332 |     if not fsxInstalledExecutable.Exists then
333 |         Console.WriteLine "install first"
334 |         Environment.Exit 1
335 | 
336 |     let testProcess =
337 |         Process.Execute(
338 |             {
339 |                 Command = fsxInstalledExecutable.FullName
340 |                 Arguments = Path.Combine(ScriptsDir.FullName, "runTests.fsx")
341 |             },
342 |             Echo.All
343 |         )
344 | 
345 |     match testProcess.Result with
346 |     | Error _ -> failwith "Tests failed"
347 |     | _ -> ()
348 | 
349 |     // the reason to write the result of this to a file is:
350 |     // if error propagation is broken, then it would be broken as well for make.fsx
351 |     // when trying to call runTests.fsx and wouldn't pick up an err
352 |     let errorPropagationResultFile =
353 |         Path.Combine(TestDir.FullName, "errProp.txt") |> FileInfo
354 | 
355 |     let errorPropagationResult =
356 |         File
357 |             .ReadAllText(errorPropagationResultFile.FullName)
358 |             .Trim()
359 | 
360 |     match errorPropagationResult with
361 |     | "1" -> failwith "Tests failed (error propagation)"
362 |     | "0" -> ()
363 |     | _ -> failwith "Unexpected output from tests (error propagation)"
364 | 
365 | | Some someOtherTarget ->
366 |     Console.Error.WriteLine("Unrecognized target: " + someOtherTarget)
367 |     Environment.Exit 1
368 | 


--------------------------------------------------------------------------------
/.github/workflows/CI.yml:
--------------------------------------------------------------------------------
  1 | name: CI
  2 | 
  3 | on:
  4 |   push:
  5 |   pull_request:
  6 |   workflow_dispatch:
  7 | 
  8 |   # see https://docs.github.com/en/actions/using-workflows/events-that-trigger-workflows#schedule
  9 |   schedule:
 10 |     # once a day
 11 |     - cron: "0 0 * * *"
 12 | 
 13 | jobs:
 14 | 
 15 |   publish:
 16 | 
 17 |     needs:
 18 |     - sanity-check
 19 | 
 20 |     runs-on: ubuntu-22.04
 21 |     container:
 22 |       image: "ubuntu:22.04"
 23 |     env:
 24 |       NUGET_API_KEY: ${{ secrets.NUGET_API_KEY }}
 25 |     steps:
 26 |       - uses: actions/checkout@v1
 27 |       - name: install sudo
 28 |         run: apt update && apt install --yes sudo
 29 |       - name: install dependencies
 30 |         run: |
 31 |             sudo apt install --yes git
 32 | 
 33 |             sudo DEBIAN_FRONTEND=noninteractive apt install --yes dotnet6
 34 | 
 35 |       # workaround for https://github.com/actions/runner/issues/2033
 36 |       - name: ownership workaround
 37 |         run: git config --global --add safe.directory '*'
 38 | 
 39 |       - name: Publish nuget packages
 40 |         run: dotnet fsi scripts/publish.fsx
 41 | 
 42 |   sanity-check:
 43 |     needs:
 44 |     - macOS--dotnet6-and-mono
 45 |     - macOS--mono
 46 |     - linux-newLTS-github--dotnet-and-xbuild
 47 |     - linux-newLTS-github--dotnet-and-msbuild
 48 |     - linux-newLTS-vanilla--stockmono
 49 |     - linux-newLTS-vanilla--newmono
 50 |     - linux-newLTS-vanilla--dotnet6
 51 |     - windows--legacyFramework
 52 |     - windows--dotnet6
 53 | 
 54 |     runs-on: ubuntu-22.04
 55 |     steps:
 56 |     - uses: actions/checkout@v1
 57 |       with:
 58 |         submodules: recursive
 59 |         # needed because of commit-lint, see https://github.com/conventional-changelog/commitlint/issues/3376
 60 |         fetch-depth: 0
 61 | 
 62 |     - name: Install dependencies of commitlint
 63 |       run: |
 64 |         sudo apt update --yes
 65 |         sudo apt install --yes npm
 66 | 
 67 |     - name: Pull our commitlint configuration
 68 |       run: |
 69 |         git clone https://github.com/nblockchain/conventions.git
 70 |         rm -rf conventions/.git/
 71 |     - name: Validate current commit (last commit) with commitlint
 72 |       if: github.event_name == 'push'
 73 |       run: ./conventions/commitlint.sh --from HEAD~1 --to HEAD --verbose
 74 |     - name: Validate PR commits with commitlint
 75 |       if: github.event_name == 'pull_request'
 76 |       run: ./conventions/commitlint.sh --from ${{ github.event.pull_request.head.sha }}~${{ github.event.pull_request.commits }} --to ${{ github.event.pull_request.head.sha }} --verbose
 77 | 
 78 |     - name: Setup .NET SDK 6.0.x
 79 |       uses: actions/setup-dotnet@v1.7.2
 80 |       with:
 81 |         dotnet-version: '6.0.x'
 82 |     - name: fantomless
 83 |       run: |
 84 |         dotnet new tool-manifest
 85 |         dotnet tool install fantomless-tool --version 4.7.996
 86 |         dotnet fantomless --recurse .
 87 |         git diff --exit-code
 88 | 
 89 |   macOS--dotnet6-and-mono:
 90 |     runs-on: macOS-13
 91 |     steps:
 92 |     - uses: actions/checkout@v1
 93 |     - name: Setup .NET SDK 6.0.x
 94 |       uses: actions/setup-dotnet@v1.7.2
 95 |       with:
 96 |         dotnet-version: '6.0.x'
 97 |     - name: configure
 98 |       run: ./configure.sh
 99 |     - name: build in DEBUG mode
100 |       run: make
101 |     - name: run unit tests
102 |       run: dotnet fsi scripts/runUnitTests.fsx
103 | 
104 |     - name: install
105 |       run: |
106 |         # to clean Debug artifacts first (make install builds in Release config)
107 |         git clean -fdx
108 | 
109 |         ./configure.sh
110 |         make release
111 |         sudo make install
112 | 
113 |     - name: run tests
114 |       run: make check
115 |     - name: compile this repo's .fsx scripts with fsx
116 |       run: ./compileFSharpScripts.fsx
117 | 
118 |   macOS--mono:
119 |     runs-on: macOS-13
120 |     steps:
121 |     - uses: actions/checkout@v1
122 |     - name: HACK to emulate dotnet uninstall
123 |       run: sudo rm -f `which dotnet`
124 |     - name: configure
125 |       run: ./configure.sh
126 |     - name: build in DEBUG mode
127 |       run: make
128 |     - name: run unit tests
129 |       run: fsharpi --define:LEGACY_FRAMEWORK scripts/runUnitTests.fsx
130 | 
131 |     - name: install
132 |       run: |
133 |         # to clean Debug artifacts first (make install builds in Release config)
134 |         git clean -fdx
135 | 
136 |         ./configure.sh
137 |         make release
138 |         sudo make install
139 | 
140 |     - name: run tests
141 |       run: make check
142 |     - name: compile this repo's .fsx scripts with fsx
143 |       run: ./compileFSharpScripts.fsx
144 | 
145 |   linux-newLTS-github--dotnet-and-xbuild:
146 |     runs-on: ubuntu-22.04
147 |     env:
148 |       DOTNET_ROLL_FORWARD: major
149 |     steps:
150 |     - uses: actions/checkout@v1
151 |     - name: check mono version
152 |       run: mono --version
153 |     - name: install dependencies
154 |       run: sudo apt install --yes fsharp
155 |     - name: check mono version
156 |       run: mono --version
157 |     - name: configure
158 |       run: ./configure.sh
159 |     - name: build in DEBUG mode
160 |       run: make
161 |     - name: run unit tests
162 |       run: dotnet fsi scripts/runUnitTests.fsx
163 | 
164 |     - name: install
165 |       run: |
166 |         # to clean Debug artifacts first (make install builds in Release config)
167 |         git clean -fdx
168 | 
169 |         ./configure.sh
170 |         make release
171 |         sudo make install
172 | 
173 |     - name: run tests
174 |       run: make check
175 |     - name: compile this repo's .fsx scripts with fsx
176 |       run: ./compileFSharpScripts.fsx
177 | 
178 |   linux-newLTS-github--dotnet-and-msbuild:
179 |     runs-on: ubuntu-22.04
180 |     env:
181 |       DOTNET_ROLL_FORWARD: major
182 |     steps:
183 |     - uses: actions/checkout@v1
184 |     - name: check mono version
185 |       run: mono --version
186 |     - name: install last version of mono (Microsoft APT repositories)
187 |       run: sudo ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
188 |     - name: check mono version
189 |       run: mono --version
190 |     - name: configure
191 |       run: ./configure.sh
192 |     - name: build in DEBUG mode
193 |       run: make
194 |     - name: run unit tests
195 |       run: dotnet fsi scripts/runUnitTests.fsx
196 | 
197 |     - name: install
198 |       run: |
199 |         # to clean Debug artifacts first (make install builds in Release config)
200 |         git clean -fdx
201 | 
202 |         ./configure.sh
203 |         make release
204 |         sudo make install
205 | 
206 |     - name: run tests
207 |       run: make check
208 |     - name: compile this repo's .fsx scripts with fsx
209 |       run: ./compileFSharpScripts.fsx
210 | 
211 |   linux-newLTS-vanilla--stockmono:
212 |     runs-on: ubuntu-22.04
213 |     container:
214 |       image: "ubuntu:22.04"
215 |     steps:
216 |     - uses: actions/checkout@v1
217 |     - name: install sudo
218 |       run: apt update && apt install --yes sudo
219 |     - name: install all dependencies
220 |       run: sudo DEBIAN_FRONTEND=noninteractive apt install --yes git make curl fsharp nunit-console
221 | 
222 |     # workaround for https://github.com/actions/runner/issues/2033
223 |     - name: ownership workaround
224 |       run: git config --global --add safe.directory '*'
225 | 
226 |     - name: check mono version
227 |       run: mono --version
228 |     - name: install dependencies
229 |       run: sudo apt install --yes fsharp
230 |     - name: check mono version
231 |       run: mono --version
232 |     - name: configure
233 |       run: ./configure.sh
234 |     - name: build in DEBUG mode
235 |       run: make
236 | 
237 |     - name: install
238 |       run: |
239 |         # to clean Debug artifacts first (make install builds in Release config)
240 |         git clean -fdx
241 | 
242 |         ./configure.sh
243 |         make release
244 |         sudo make install
245 | 
246 |     - name: run unit tests
247 |       run: ./scripts/runUnitTests.fsx
248 |     - name: run tests
249 |       run: make check
250 |     - name: compile this repo's .fsx scripts with fsx
251 |       run: ./compileFSharpScripts.fsx
252 | 
253 |   linux-newLTS-vanilla--newmono:
254 |     runs-on: ubuntu-22.04
255 |     container:
256 |       image: "ubuntu:22.04"
257 |     steps:
258 |     - uses: actions/checkout@v1
259 |     - name: install sudo
260 |       run: apt update && apt install --yes sudo
261 |     - name: install last version of mono (Microsoft APT repositories)
262 |       run: sudo ./scripts/CI/install_mono_from_microsoft_deb_packages.sh
263 |     - name: install rest of dependencies
264 |       run: sudo DEBIAN_FRONTEND=noninteractive apt install --yes git make curl fsharp nunit-console
265 | 
266 |     # workaround for https://github.com/actions/runner/issues/2033
267 |     - name: ownership workaround
268 |       run: git config --global --add safe.directory '*'
269 | 
270 |     - name: check mono version
271 |       run: mono --version
272 |     - name: install dependencies
273 |       run: sudo apt install --yes fsharp
274 |     - name: check mono version
275 |       run: mono --version
276 |     - name: configure
277 |       run: ./configure.sh
278 |     - name: build in DEBUG mode
279 |       run: make
280 |     - name: run unit tests
281 |       run: fsharpi --define:LEGACY_FRAMEWORK scripts/runUnitTests.fsx
282 | 
283 |     - name: install
284 |       run: |
285 |         # to clean Debug artifacts first (make install builds in Release config)
286 |         git clean -fdx
287 | 
288 |         ./configure.sh
289 |         make release
290 |         sudo make install
291 | 
292 |     - name: run tests
293 |       run: make check
294 |     - name: compile this repo's .fsx scripts with fsx
295 |       run: ./compileFSharpScripts.fsx
296 | 
297 |   linux-newLTS-vanilla--dotnet6:
298 |     runs-on: ubuntu-22.04
299 |     container:
300 |       image: "ubuntu:22.04"
301 |     steps:
302 |     - uses: actions/checkout@v1
303 |     - name: install sudo
304 |       run: apt update && apt install --yes sudo
305 |     - name: install dependencies
306 |       run: sudo DEBIAN_FRONTEND=noninteractive apt install --yes git make dotnet6
307 | 
308 |     # workaround for https://github.com/actions/runner/issues/2033
309 |     - name: ownership workaround
310 |       run: git config --global --add safe.directory '*'
311 | 
312 |     - name: check dotnet version
313 |       run: dotnet --version
314 |     - name: configure
315 |       run: ./configure.sh
316 |     - name: build in DEBUG mode
317 |       run: make
318 |     - name: run unit tests
319 |       run: dotnet fsi scripts/runUnitTests.fsx
320 | 
321 |     - name: install
322 |       run: |
323 |         # to clean Debug artifacts first (make install builds in Release config)
324 |         git clean -fdx
325 | 
326 |         ./configure.sh
327 |         make release
328 |         sudo make install
329 | 
330 |     - name: run tests
331 |       run: make check
332 |     - name: compile this repo's .fsx scripts with fsx
333 |       run: ./compileFSharpScripts.fsx
334 | 
335 |   windows--legacyFramework:
336 |     runs-on: windows-2022
337 |     steps:
338 |     - uses: actions/checkout@v1
339 |     - name: HACK to emulate dotnet uninstall
340 |       run: del $(where.exe dotnet)
341 |     - name: build in DEBUG mode
342 |       run: .\make.bat
343 |     - name: run unit tests
344 |       run: .\Tools\fsi.bat scripts\runUnitTests.fsx
345 | 
346 |     - name: install
347 |       run: |
348 |         # to clean Debug artifacts first (make install builds in Release config)
349 |         git clean -fdx
350 | 
351 |         .\make.bat release
352 |         .\make.bat install
353 | 
354 |     - name: run tests
355 |       run: .\make.bat check
356 |     - name: compile this repo's .fsx scripts with fsx
357 |       run: .\Tools\fsi.bat compileFSharpScripts.fsx
358 | 
359 |   windows--dotnet6:
360 |     runs-on: windows-latest
361 |     steps:
362 |     - uses: actions/checkout@v1
363 |     - name: Setup .NET SDK 6.0.x
364 |       uses: actions/setup-dotnet@v1.7.2
365 |       with:
366 |         dotnet-version: '6.0.x'
367 |     - name: build in DEBUG mode
368 |       run: .\make.bat
369 |     - name: run unit tests
370 |       run: dotnet fsi scripts/runUnitTests.fsx
371 | 
372 |     - name: install
373 |       run: |
374 |         # to clean Debug artifacts first (make install builds in Release config)
375 |         git clean -fdx
376 | 
377 |         .\make.bat release
378 |         .\make.bat install
379 | 
380 |     - name: run tests
381 |       run: .\make.bat check
382 |     - name: compile this repo's .fsx scripts with fsx
383 |       run: dotnet fsi compileFSharpScripts.fsx
384 | 
385 | 


--------------------------------------------------------------------------------
/Fsdk/FSharpUtil.fs:
--------------------------------------------------------------------------------
  1 | namespace Fsdk
  2 | 
  3 | open System
  4 | open System.Linq
  5 | open System.Threading.Tasks
  6 | open System.Runtime.ExceptionServices
  7 | 
  8 | 
  9 | // FIXME: replace all usages of the below with native FSharp.Core's Result type (https://docs.microsoft.com/en-us/dotnet/fsharp/language-reference/results)
 10 | // when the stockmono_* lanes can use at least F# v4.5
 11 | type Either<'Val, 'Err when 'Err :> Exception> =
 12 |     | FailureResult of 'Err
 13 |     | SuccessfulValue of 'Val
 14 | 
 15 | module FSharpUtil =
 16 | 
 17 |     type internal ResultWrapper<'T>(value: 'T) =
 18 | 
 19 |         // hack?
 20 |         inherit Exception()
 21 | 
 22 |         member __.Value = value
 23 | 
 24 | 
 25 |     type IErrorMsg =
 26 |         abstract member Message: string
 27 |         abstract member ChannelBreakdown: bool
 28 | 
 29 |     let UnwrapOption<'T> (opt: Option<'T>) (msg: string) : 'T =
 30 |         match opt with
 31 |         | Some value -> value
 32 |         | None -> failwith <| sprintf "error unwrapping Option: %s" msg
 33 | 
 34 |     module AsyncExtensions =
 35 |         let private makeBoxed(job: Async<'a>) : Async<obj> =
 36 |             async {
 37 |                 let! result = job
 38 |                 return box result
 39 |             }
 40 | 
 41 |         let MixedParallel2 (a: Async<'T1>) (b: Async<'T2>) : Async<'T1 * 'T2> =
 42 |             async {
 43 |                 let! results = Async.Parallel [| makeBoxed a; makeBoxed b |]
 44 |                 return (unbox<'T1> results.[0]), (unbox<'T2> results.[1])
 45 |             }
 46 | 
 47 |         let MixedParallel3
 48 |             (a: Async<'T1>)
 49 |             (b: Async<'T2>)
 50 |             (c: Async<'T3>)
 51 |             : Async<'T1 * 'T2 * 'T3> =
 52 |             async {
 53 |                 let! results =
 54 |                     Async.Parallel
 55 |                         [|
 56 |                             makeBoxed a
 57 |                             makeBoxed b
 58 |                             makeBoxed c
 59 |                         |]
 60 | 
 61 |                 return
 62 |                     (unbox<'T1> results.[0]),
 63 |                     (unbox<'T2> results.[1]),
 64 |                     (unbox<'T3> results.[2])
 65 |             }
 66 | 
 67 |         let MixedParallel4
 68 |             (a: Async<'T1>)
 69 |             (b: Async<'T2>)
 70 |             (c: Async<'T3>)
 71 |             (d: Async<'T4>)
 72 |             : Async<'T1 * 'T2 * 'T3 * 'T4> =
 73 |             async {
 74 |                 let! results =
 75 |                     Async.Parallel
 76 |                         [|
 77 |                             makeBoxed a
 78 |                             makeBoxed b
 79 |                             makeBoxed c
 80 |                             makeBoxed d
 81 |                         |]
 82 | 
 83 |                 return
 84 |                     (unbox<'T1> results.[0]),
 85 |                     (unbox<'T2> results.[1]),
 86 |                     (unbox<'T3> results.[2]),
 87 |                     (unbox<'T4> results.[3])
 88 |             }
 89 | 
 90 |         // efficient raise
 91 |         let private RaiseResult(e: ResultWrapper<'T>) =
 92 |             Async.FromContinuations(fun (_, econt, _) -> econt e)
 93 | 
 94 |         /// Given sequence of computations, run them in parallel and
 95 |         /// return result of computation that finishes first.
 96 |         /// Like Async.Choice, but with no need for Option<T> types
 97 |         let WhenAny<'T>(jobs: seq<Async<'T>>) : Async<'T> =
 98 |             let wrap(job: Async<'T>) : Async<Option<'T>> =
 99 |                 async {
100 |                     let! res = job
101 |                     return Some res
102 |                 }
103 | 
104 |             async {
105 |                 let wrappedJobs = jobs |> Seq.map wrap
106 |                 let! combinedRes = Async.Choice wrappedJobs
107 | 
108 |                 match combinedRes with
109 |                 | Some x -> return x
110 |                 | None -> return failwith "unreachable"
111 |             }
112 | 
113 |         /// Given sequence of computations, create a computation that runs them in parallel
114 |         /// and as soon as one of sub-computations is finished, return another computation,
115 |         /// that will wait until all sub-computations are finished, and return their results.
116 |         let WhenAnyAndAll<'T>(jobs: seq<Async<'T>>) : Async<Async<array<'T>>> =
117 |             let taskSource = TaskCompletionSource<unit>()
118 | 
119 |             let wrap(job: Async<'T>) =
120 |                 async {
121 |                     let! res = job
122 |                     taskSource.TrySetResult() |> ignore<bool>
123 |                     return res
124 |                 }
125 | 
126 |             async {
127 |                 let allJobsInParallel =
128 |                     jobs |> Seq.map wrap |> Async.Parallel |> Async.StartChild
129 | 
130 |                 let! allJobsStarted = allJobsInParallel
131 |                 let! _ = Async.AwaitTask taskSource.Task
132 |                 return allJobsStarted
133 |             }
134 | 
135 |     let rec private ListIntersectInternal list1 list2 offset acc currentIndex =
136 |         match list1, list2 with
137 |         | [], [] -> List.rev acc
138 |         | [], _ -> List.append (List.rev acc) list2
139 |         | _, [] -> List.append (List.rev acc) list1
140 |         | head1 :: tail1, head2 :: tail2 ->
141 |             if currentIndex % (int offset) = 0 then
142 |                 ListIntersectInternal
143 |                     list1
144 |                     tail2
145 |                     offset
146 |                     (head2 :: acc)
147 |                     (currentIndex + 1)
148 |             else
149 |                 ListIntersectInternal
150 |                     tail1
151 |                     list2
152 |                     offset
153 |                     (head1 :: acc)
154 |                     (currentIndex + 1)
155 | 
156 |     let ListIntersect<'T>
157 |         (list1: List<'T>)
158 |         (list2: List<'T>)
159 |         (offset: uint32)
160 |         : List<'T> =
161 |         ListIntersectInternal list1 list2 offset [] 1
162 | 
163 |     let SeqTryHeadTail<'T>(sequence: seq<'T>) : Option<'T * seq<'T>> =
164 |         match Seq.tryHead sequence with
165 |         | None -> None
166 |         | Some head -> Some(head, Seq.tail sequence)
167 | 
168 |     let rec SeqAsyncTryPick<'T, 'U>
169 |         (sequence: seq<'T>)
170 |         (chooser: 'T -> Async<Option<'U>>)
171 |         : Async<Option<'U>> =
172 |         async {
173 |             match SeqTryHeadTail sequence with
174 |             | None -> return None
175 |             | Some(head, tail) ->
176 |                 let! choiceOpt = chooser head
177 | 
178 |                 match choiceOpt with
179 |                 | None -> return! SeqAsyncTryPick tail chooser
180 |                 | Some choice -> return Some choice
181 |         }
182 | 
183 |     let ListAsyncTryPick<'T, 'U>
184 |         (list: list<'T>)
185 |         (chooser: 'T -> Async<Option<'U>>)
186 |         : Async<Option<'U>> =
187 |         SeqAsyncTryPick (list |> Seq.ofList) chooser
188 | 
189 |     // TODO: remove this once we drop LEGACY_FRAMEWORK support (as FSharp.Core's Async.Sleep(TimeSpan) overload can be used)
190 |     let SleepSpan(span: TimeSpan) =
191 |         Async.Sleep(int span.TotalMilliseconds)
192 | 
193 |     let WithTimeout (timeSpan: TimeSpan) (job: Async<'R>) : Async<Option<'R>> =
194 |         async {
195 |             let read =
196 |                 async {
197 |                     let! value = job
198 |                     return value |> SuccessfulValue |> Some
199 |                 }
200 | 
201 |             let delay =
202 |                 async {
203 |                     let total = int timeSpan.TotalMilliseconds
204 |                     do! Async.Sleep total
205 |                     return FailureResult <| TimeoutException() |> Some
206 |                 }
207 | 
208 |             let! dummyOption = Async.Choice([ read; delay ])
209 | 
210 |             match dummyOption with
211 |             | Some theResult ->
212 |                 match theResult with
213 |                 | SuccessfulValue r -> return Some r
214 |                 | FailureResult _ -> return None
215 |             | None ->
216 |                 // none of the jobs passed to Async.Choice returns None
217 |                 return failwith "unreachable"
218 |         }
219 | 
220 |     // NOTE: no need for this workaround anymore after this gets addressed:
221 |     //        https://github.com/fsharp/fslang-suggestions/issues/660
222 |     // TODO: actually, reraise in async blocks is not that important; rather use Result<TSuccess,TErr>!
223 |     //       so let's mark this as [<Obsolete>] with this recommendation
224 |     let ReRaise(ex: Exception) : Exception =
225 |         (ExceptionDispatchInfo.Capture ex).Throw()
226 |         failwith "Should be unreachable"
227 |         ex
228 | 
229 |     let rec public FindException<'T when 'T :> Exception>
230 |         (ex: Exception)
231 |         : Option<'T> =
232 |         let rec findExInSeq(sq: seq<Exception>) =
233 |             match Seq.tryHead sq with
234 |             | Some head ->
235 |                 let found = FindException head
236 | 
237 |                 match found with
238 |                 | Some ex -> Some ex
239 |                 | None -> findExInSeq <| Seq.tail sq
240 |             | None -> None
241 | 
242 |         if null = ex then
243 |             None
244 |         else
245 |             match ex with
246 |             | :? 'T as specificEx -> Some(specificEx)
247 |             | :? AggregateException as aggEx ->
248 |                 findExInSeq aggEx.InnerExceptions
249 |             | _ -> FindException<'T>(ex.InnerException)
250 | 
251 |     // Searches through an exception tree and ensures that all the leaves of
252 |     // the tree have type 'T. Returns these 'T exceptions as a sequence, or
253 |     // otherwise re-raises the original exception if there are any non-'T-based
254 |     // exceptions in the tree.
255 |     let public FindSingleException<'T when 'T :> Exception>
256 |         (ex: Exception)
257 |         : seq<'T> =
258 |         let rec findSingleExceptionOpt(ex: Exception) : Option<seq<'T>> =
259 |             let rec findSingleExceptionInSeq
260 |                 (sq: seq<Exception>)
261 |                 (acc: seq<'T>)
262 |                 : Option<seq<'T>> =
263 |                 match Seq.tryHead sq with
264 |                 | Some head ->
265 |                     match findSingleExceptionOpt head with
266 |                     | Some exs ->
267 |                         findSingleExceptionInSeq
268 |                             (Seq.tail sq)
269 |                             (Seq.concat [ acc; exs ])
270 |                     | None -> None
271 |                 | None -> Some acc
272 | 
273 |             let findSingleInnerException(ex: Exception) : Option<seq<'T>> =
274 |                 if null = ex.InnerException then
275 |                     None
276 |                 else
277 |                     findSingleExceptionOpt ex.InnerException
278 | 
279 |             match ex with
280 |             | :? 'T as specificEx -> Some <| Seq.singleton specificEx
281 |             | :? AggregateException as aggEx ->
282 |                 findSingleExceptionInSeq aggEx.InnerExceptions Seq.empty
283 |             | _ -> findSingleInnerException ex
284 | 
285 |         match findSingleExceptionOpt ex with
286 |         | Some exs -> exs
287 |         | None ->
288 |             ReRaise ex |> ignore<Exception>
289 |             failwith "unreachable"
290 | 
291 |     type OptionBuilder() =
292 |         // see https://github.com/dsyme/fsharp-presentations/blob/master/design-notes/ces-compared.md#overview-of-f-computation-expressions
293 |         member x.Bind(v, f) =
294 |             Option.bind f v
295 | 
296 |         member x.Return v =
297 |             Some v
298 | 
299 |         member x.ReturnFrom o =
300 |             o
301 | 
302 |         member x.Zero() =
303 |             None
304 | 
305 |     let option = OptionBuilder()
306 | 
307 |     let Retry<'T, 'TException when 'TException :> Exception>
308 |         sourceFunc
309 |         retryCount
310 |         : Async<'T> =
311 |         async {
312 |             let rec retrySourceFunc currentRetryCount =
313 |                 async {
314 |                     try
315 |                         return! sourceFunc()
316 |                     with
317 |                     | ex ->
318 |                         match FindException<'TException> ex with
319 |                         | Some ex ->
320 |                             if currentRetryCount = 0 then
321 |                                 return raise <| ReRaise ex
322 | 
323 |                             return! retrySourceFunc(currentRetryCount - 1)
324 |                         | None -> return raise <| ReRaise ex
325 |                 }
326 | 
327 |             return! retrySourceFunc retryCount
328 |         }
329 | 


--------------------------------------------------------------------------------
/scripts/runTests.fsx:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/env fsx
  2 | 
  3 | open System
  4 | open System.IO
  5 | open System.Net
  6 | open System.Linq
  7 | open System.Diagnostics
  8 | 
  9 | #r "System.Configuration"
 10 | open System.Configuration
 11 | 
 12 | #load "../Fsdk/Misc.fs"
 13 | #load "../Fsdk/Process.fs"
 14 | #load "../Fsdk/Git.fs"
 15 | #load "../Fsdk/Network.fs"
 16 | 
 17 | open Fsdk
 18 | open Fsdk.Process
 19 | 
 20 | let ScriptsDir = __SOURCE_DIRECTORY__ |> DirectoryInfo
 21 | let RootDir = Path.Combine(ScriptsDir.FullName, "..") |> DirectoryInfo
 22 | let TestDir = Path.Combine(RootDir.FullName, "test") |> DirectoryInfo
 23 | let NugetDir = Path.Combine(RootDir.FullName, ".nuget") |> DirectoryInfo
 24 | let NugetExe = Path.Combine(NugetDir.FullName, "nuget.exe") |> FileInfo
 25 | let NugetPackages = Path.Combine(RootDir.FullName, "packages") |> DirectoryInfo
 26 | 
 27 | let GetFsxWindowsLauncher() =
 28 |     let programFiles =
 29 |         Environment.GetEnvironmentVariable "ProgramW6432" |> DirectoryInfo
 30 | 
 31 |     let fsxWinInstallationDir =
 32 |         Path.Combine(programFiles.FullName, "fsx") |> DirectoryInfo
 33 | 
 34 | #if !LEGACY_FRAMEWORK
 35 |     Path.Combine(fsxWinInstallationDir.FullName, "fsx.bat") |> FileInfo
 36 | #else
 37 |     Path.Combine(fsxWinInstallationDir.FullName, "fsx.exe") |> FileInfo
 38 | #endif
 39 | 
 40 | let CreateCommand(executable: FileInfo, args: string) =
 41 |     let platform = Misc.GuessPlatform()
 42 | 
 43 |     if (executable.FullName.ToLower().EndsWith(".exe")
 44 |         && platform = Misc.Platform.Windows)
 45 |        ||
 46 |        // because shebang works in Unix
 47 |        (executable.FullName.ToLower().EndsWith(".fsx")
 48 |         && platform <> Misc.Platform.Windows) then
 49 |         {
 50 |             Command = executable.FullName
 51 |             Arguments = args
 52 |         }
 53 | 
 54 |     elif
 55 |         executable.FullName.ToLower().EndsWith(".fsx")
 56 |         && platform = Misc.Platform.Windows
 57 |     then
 58 |         {
 59 |             Command = GetFsxWindowsLauncher().FullName
 60 |             Arguments = sprintf "%s %s" executable.FullName args
 61 |         }
 62 |     elif
 63 |         executable.FullName.ToLower().EndsWith(".exe")
 64 |         && platform <> Misc.Platform.Windows
 65 |     then
 66 |         {
 67 |             Command = "mono"
 68 |             Arguments = sprintf "%s %s" executable.FullName args
 69 |         }
 70 |     else
 71 |         failwith "Unexpected command, you broke 'make check'"
 72 | 
 73 | 
 74 | let fsharpCompilerCommand =
 75 | #if !LEGACY_FRAMEWORK
 76 |     "dotnet"
 77 | #else
 78 |     match Misc.GuessPlatform() with
 79 |     | Misc.Platform.Windows ->
 80 |         match Process.VsWhere "**\\fsc.exe" with
 81 |         | None -> failwith "fsc.exe not found"
 82 |         | Some fscExe -> fscExe
 83 |     | _ -> "fsharpc"
 84 | #endif
 85 | 
 86 | let UnwrapDefault(proc: ProcessResult) =
 87 | #if !LEGACY_FRAMEWORK
 88 | // FIXME: this workaround below is needed because we got warnings in .NET6
 89 |     match proc.Result with
 90 |     | Error _ ->
 91 |         failwithf
 92 |             "Process '%s %s' failed"
 93 |             proc.Details.Command
 94 |             proc.Details.Args
 95 |     | _ -> ()
 96 | #else
 97 |     proc.UnwrapDefault() |> ignore<string>
 98 | #endif
 99 | 
100 | let fsxWorkingCommandInUnixAfterBeingInstalled =
101 |     {
102 |         Command = "/usr/bin/env"
103 |         Arguments = "fsx"
104 |     }
105 | 
106 | let helpCommand =
107 |     let helpFlag = "--help"
108 | 
109 |     match Misc.GuessPlatform() with
110 |     | Misc.Platform.Windows ->
111 |         {
112 |             Command = GetFsxWindowsLauncher().FullName
113 |             Arguments = helpFlag
114 |         }
115 |     | _ ->
116 |         {
117 |             Command = fsxWorkingCommandInUnixAfterBeingInstalled.Command
118 |             Arguments =
119 |                 sprintf
120 |                     "%s %s"
121 |                     fsxWorkingCommandInUnixAfterBeingInstalled.Arguments
122 |                     helpFlag
123 |         }
124 | 
125 | Process.Execute(helpCommand, Echo.All) |> UnwrapDefault
126 | 
127 | let basicTest = Path.Combine(TestDir.FullName, "test.fsx") |> FileInfo
128 | 
129 | Process.Execute(CreateCommand(basicTest, String.Empty), Echo.All)
130 | |> UnwrapDefault
131 | 
132 | 
133 | let ifDefTest = Path.Combine(TestDir.FullName, "testIfDef.fsx") |> FileInfo
134 | 
135 | Process.Execute(CreateCommand(ifDefTest, String.Empty), Echo.All)
136 | |> UnwrapDefault
137 | 
138 | 
139 | let nonExistentTest =
140 |     Path.Combine(TestDir.FullName, "nonExistentFsx.fsx") |> FileInfo
141 | 
142 | let commandForNonExistentTest =
143 |     if Misc.GuessPlatform() = Misc.Platform.Windows then
144 |         GetFsxWindowsLauncher().FullName
145 |     else
146 |         // FIXME: extract PREFIX from build.config instead of assuming default
147 |         "/usr/local/bin/fsx"
148 | 
149 | let proc =
150 |     Process.Execute(
151 |         {
152 |             Command = commandForNonExistentTest
153 |             Arguments = nonExistentTest.FullName
154 |         },
155 |         Echo.All
156 |     )
157 | 
158 | // the reason to write the result of this to a file is:
159 | // if error propagation is broken, then it would be broken as well for make.fsx
160 | // when trying to call this very file (runTests.fsx) and wouldn't pick up an err
161 | let errorPropagationResultFile =
162 |     Path.Combine(TestDir.FullName, "errProp.txt") |> FileInfo
163 | 
164 | match proc.Result with
165 | | Error _ -> File.WriteAllText(errorPropagationResultFile.FullName, "0")
166 | | _ ->
167 |     File.WriteAllText(errorPropagationResultFile.FullName, "1")
168 |     failwith "Call to non-existent test should have failed (exitCode <> 0)"
169 | 
170 | 
171 | let fsFileToBuild = Path.Combine(TestDir.FullName, "test.fs") |> FileInfo
172 | let libToRef1 = Path.Combine(TestDir.FullName, "test1.dll") |> FileInfo
173 | #if !LEGACY_FRAMEWORK
174 | let testLibFsProjContent =
175 |     """
176 | <Project Sdk="Microsoft.NET.Sdk">
177 | 
178 |   <PropertyGroup>
179 |     <TargetFramework>netstandard2.0</TargetFramework>
180 | 
181 |     <!-- the two settings below allow the binaries sit directly in subfolder /bin/ -->
182 |     <OutputPath>.</OutputPath>
183 |     <AppendTargetFrameworkToOutputPath>false</AppendTargetFrameworkToOutputPath>
184 |   </PropertyGroup>
185 | 
186 |   <ItemGroup>
187 |     <Compile Include="test.fs" />
188 |   </ItemGroup>
189 | 
190 | </Project>
191 | """
192 | 
193 | let test1LibFsProj = Path.Combine(TestDir.FullName, "test1.fsproj") |> FileInfo
194 | 
195 | try
196 |     File.WriteAllText(test1LibFsProj.FullName, testLibFsProjContent)
197 | 
198 |     let dotnetBuildCmd1 =
199 |         {
200 |             Command = fsharpCompilerCommand
201 |             Arguments = sprintf "build %s" test1LibFsProj.FullName
202 |         }
203 | 
204 |     Process
205 |         .Execute(dotnetBuildCmd1, Echo.All)
206 |         .UnwrapDefault()
207 |     |> ignore<string>
208 | finally
209 |     test1LibFsProj.Delete()
210 | 
211 | #else
212 | 
213 | 
214 | let fscCmd1 =
215 |     {
216 |         Command = fsharpCompilerCommand
217 |         Arguments =
218 |             sprintf
219 |                 "%s --target:library --out:%s"
220 |                 fsFileToBuild.FullName
221 |                 libToRef1.FullName
222 |     }
223 | 
224 | Process.Execute(fscCmd1, Echo.All).UnwrapDefault() |> ignore<string>
225 | #endif
226 | let refLibTest = Path.Combine(TestDir.FullName, "testRefLib.fsx") |> FileInfo
227 | 
228 | Process.Execute(CreateCommand(refLibTest, String.Empty), Echo.All)
229 | |> UnwrapDefault
230 | 
231 | 
232 | let subLibFolder =
233 |     Directory.CreateDirectory(Path.Combine(TestDir.FullName, "lib"))
234 | 
235 | let libToRef2Outside =
236 |     Path.Combine(subLibFolder.FullName, "test2.dll") |> FileInfo
237 | #if !LEGACY_FRAMEWORK
238 | let libToRef2 = Path.Combine(TestDir.FullName, "test2.dll") |> FileInfo
239 | let test2LibFsProj = Path.Combine(TestDir.FullName, "test2.fsproj") |> FileInfo
240 | 
241 | try
242 |     File.WriteAllText(test2LibFsProj.FullName, testLibFsProjContent)
243 | 
244 |     let dotnetBuildCmd2 =
245 |         {
246 |             Command = fsharpCompilerCommand
247 |             Arguments = sprintf "build %s" test2LibFsProj.FullName
248 |         }
249 | 
250 |     Process
251 |         .Execute(dotnetBuildCmd2, Echo.All)
252 |         .UnwrapDefault()
253 |     |> ignore<string>
254 | 
255 |     File.Copy(libToRef2.FullName, libToRef2Outside.FullName, true)
256 | finally
257 |     test2LibFsProj.Delete()
258 | #else
259 | let fscCmd2 =
260 |     {
261 |         Command = fsharpCompilerCommand
262 |         Arguments =
263 |             sprintf
264 |                 "%s --target:library --out:%s"
265 |                 fsFileToBuild.FullName
266 |                 libToRef2Outside.FullName
267 |     }
268 | 
269 | Process.Execute(fscCmd2, Echo.All).UnwrapDefault() |> ignore<string>
270 | #endif
271 | 
272 | let refLibOutsideCurrentFolderTest =
273 |     Path.Combine(TestDir.FullName, "testRefLibOutsideCurrentFolder.fsx")
274 |     |> FileInfo
275 | 
276 | Process.Execute(
277 |     CreateCommand(refLibOutsideCurrentFolderTest, String.Empty),
278 |     Echo.All
279 | )
280 | |> UnwrapDefault
281 | 
282 | // this test doesn't make much sense when running dotnet because we would use proper #r "nuget: ..." in that case
283 | #if LEGACY_FRAMEWORK
284 | Network.InstallNugetPackage
285 |     NugetExe
286 |     NugetPackages
287 |     "Microsoft.Build"
288 |     (Some "16.11.0")
289 |     Echo.All
290 | |> ignore
291 | 
292 | let refNugetLibTest =
293 |     Path.Combine(TestDir.FullName, "testRefNugetLib.fsx") |> FileInfo
294 | 
295 | Process.Execute(CreateCommand(refNugetLibTest, String.Empty), Echo.All)
296 | |> UnwrapDefault
297 | #endif
298 | 
299 | // not specifying a version is tricky to convert into a <PackageReference /> so not supported atm
300 | #if LEGACY_FRAMEWORK
301 | let refNugetLibTestNewFormat =
302 |     Path.Combine(TestDir.FullName, "testRefNugetLibNewFormat.fsx") |> FileInfo
303 | 
304 | Process.Execute(CreateCommand(refNugetLibTestNewFormat, String.Empty), Echo.All)
305 | |> UnwrapDefault
306 | #endif
307 | 
308 | 
309 | let refNugetLibTestNewFormatWithVersion =
310 |     Path.Combine(TestDir.FullName, "testRefNugetLibNewFormatWithVersion.fsx")
311 |     |> FileInfo
312 | 
313 | Process.Execute(
314 |     CreateCommand(refNugetLibTestNewFormatWithVersion, String.Empty),
315 |     Echo.All
316 | )
317 | |> UnwrapDefault
318 | 
319 | let refNugetLibTestNewFormatWithShortVersion =
320 |     Path.Combine(
321 |         TestDir.FullName,
322 |         "testRefNugetLibNewFormatWithShortVersion.fsx"
323 |     )
324 |     |> FileInfo
325 | 
326 | Process.Execute(
327 |     CreateCommand(refNugetLibTestNewFormatWithShortVersion, String.Empty),
328 |     Echo.All
329 | )
330 | |> UnwrapDefault
331 | 
332 | 
333 | let cmdLineArgsTest =
334 |     Path.Combine(TestDir.FullName, "testFsiCommandLineArgs.fsx") |> FileInfo
335 | 
336 | let args = "one 2 three"
337 | 
338 | Process.Execute(CreateCommand(cmdLineArgsTest, args), Echo.All) |> UnwrapDefault
339 | 
340 | #if !LEGACY_FRAMEWORK
341 | let dotnetFsiCmd =
342 |     {
343 |         Command = "dotnet"
344 |         Arguments = sprintf "fsi %s %s" cmdLineArgsTest.FullName args
345 |     }
346 | 
347 | Process.Execute(dotnetFsiCmd, Echo.All) |> UnwrapDefault
348 | #endif
349 | 
350 | let processTest = Path.Combine(TestDir.FullName, "testProcess.fsx") |> FileInfo
351 | 
352 | Process.Execute(CreateCommand(processTest, String.Empty), Echo.All)
353 | |> UnwrapDefault
354 | 
355 | 
356 | (* this is actually only really useful for when process spits both stdout & stderr
357 | let processConcurrencyTest = Path.Combine(TestDir.FullName, "testProcessConcurrency.fsx") |> FileInfo
358 | Process.Execute({ Command = processConcurrencyTest.FullName; Arguments = String.Empty }, Echo.All)
359 |        .UnwrapDefault() |> ignore<string>
360 | *)
361 | 
362 | 
363 | let legacyDefineTest =
364 |     Path.Combine(
365 |         TestDir.FullName,
366 | #if !LEGACY_FRAMEWORK
367 |         "testNonLegacyFx.fsx"
368 | #else
369 |         "testLegacyFx.fsx"
370 | #endif
371 |     )
372 |     |> FileInfo
373 | 
374 | Process.Execute(CreateCommand(legacyDefineTest, String.Empty), Echo.All)
375 | |> UnwrapDefault
376 | 
377 | 
378 | let contentOfScriptWithWarning =
379 |     sprintf
380 |         """#!%s %s
381 | 
382 | let GiveMeBool() : bool =
383 |     false
384 | 
385 | GiveMeBool()
386 | printf "hello"
387 | """
388 |         fsxWorkingCommandInUnixAfterBeingInstalled.Command
389 |         fsxWorkingCommandInUnixAfterBeingInstalled.Arguments
390 | 
391 | let warningTest = Path.Combine(TestDir.FullName, "testWarning.fsx") |> FileInfo
392 | File.WriteAllText(warningTest.FullName, contentOfScriptWithWarning)
393 | 
394 | match Misc.GuessPlatform() with
395 | | Misc.Platform.Windows -> ()
396 | | _ ->
397 |     Process
398 |         .Execute(
399 |             {
400 |                 Command = "chmod"
401 |                 Arguments = sprintf "+x %s" warningTest.FullName
402 |             },
403 |             Echo.All
404 |         )
405 |         .UnwrapDefault()
406 |     |> ignore<string>
407 | 
408 | let currentDir = Directory.GetCurrentDirectory()
409 | 
410 | let possibleDirBuildProps =
411 |     Path.Combine(currentDir, "Directory.Build.props") |> FileInfo
412 | 
413 | if possibleDirBuildProps.Exists then
414 |     // this file could alter the behaviour of fsxc when compiling, making the result of the test be misleading
415 |     possibleDirBuildProps.Delete()
416 | 
417 | let warningAsErrorProc =
418 |     Process.Execute(CreateCommand(warningTest, String.Empty), Echo.All)
419 | 
420 | match warningAsErrorProc.Result with
421 | | Error _ ->
422 |     // warning as error worked!
423 |     ()
424 | | _ ->
425 |     failwithf
426 |         "Should have failed to compile/execute %s because warnings as errors"
427 |         warningTest.Name
428 | 
429 | warningTest.Delete()
430 | 


--------------------------------------------------------------------------------
/Fsdk/Git.fs:
--------------------------------------------------------------------------------
  1 | namespace Fsdk
  2 | 
  3 | open System
  4 | open System.Linq
  5 | 
  6 | open Process
  7 | open Misc
  8 | 
  9 | module Git =
 10 | 
 11 |     let private gitCommand = "git"
 12 | 
 13 |     let rec private GetBranchFromGitBranch(outchunks: list<string>) =
 14 |         match outchunks with
 15 |         | [] ->
 16 |             failwith
 17 |                 "current branch not found, unexpected output from `git branch`"
 18 |         | head :: tail ->
 19 |             if (head.StartsWith("*")) then
 20 |                 let branchName = head.Substring("* ".Length)
 21 |                 branchName
 22 |             else
 23 |                 GetBranchFromGitBranch(tail)
 24 | 
 25 |     let private IsGitInstalled() : bool =
 26 |         let gitCheckCommand =
 27 |             match Misc.GuessPlatform() with
 28 |             | Misc.Platform.Windows ->
 29 |                 {
 30 |                     Command = "git"
 31 |                     Arguments = "--version"
 32 |                 }
 33 |             | _ ->
 34 |                 {
 35 |                     Command = "which"
 36 |                     Arguments = "git"
 37 |                 }
 38 | 
 39 |         match Process.Execute(gitCheckCommand, Echo.Off).Result with
 40 |         | Success _ -> true
 41 |         | Error _ -> false
 42 |         | WarningsOrAmbiguous output ->
 43 |             output.PrintToConsole()
 44 |             Console.WriteLine()
 45 |             Console.Out.Flush()
 46 |             Console.Error.Flush()
 47 |             failwith "Unexpected 'git' output ^ (with warnings?)"
 48 | 
 49 |     let private CheckGitIsInstalled() : unit =
 50 |         if not(IsGitInstalled()) then
 51 |             Console.Error.WriteLine "Could not continue, install 'git' first"
 52 |             Environment.Exit 1
 53 | 
 54 |     let GetCurrentBranch() =
 55 |         CheckGitIsInstalled()
 56 | 
 57 |         let gitBranch =
 58 |             Process.Execute(
 59 |                 {
 60 |                     Command = gitCommand
 61 |                     Arguments = "branch"
 62 |                 },
 63 |                 Echo.Off
 64 |             )
 65 | 
 66 |         let output = gitBranch.UnwrapDefault()
 67 |         let branchesOutput = Misc.CrossPlatformStringSplitInLines output
 68 | 
 69 |         GetBranchFromGitBranch branchesOutput
 70 | 
 71 |     let GetLastCommit() =
 72 |         CheckGitIsInstalled()
 73 | 
 74 |         let gitLogCmd =
 75 |             {
 76 |                 Command = gitCommand
 77 |                 Arguments =
 78 |                     "log --no-color --first-parent -n1 --pretty=format:%h"
 79 |             }
 80 | 
 81 |         let gitLastCommit = Process.Execute(gitLogCmd, Echo.Off)
 82 |         let output = gitLastCommit.UnwrapDefault()
 83 | 
 84 |         let lines = Misc.CrossPlatformStringSplitInLines output
 85 | 
 86 |         if (lines.Length <> 1) then
 87 |             failwith "Unexpected git output for special git log command"
 88 | 
 89 |         lines.[0]
 90 | 
 91 |     let private random = Random()
 92 | 
 93 |     let private GenerateRandomShortNameWithLettersButNoNumbers() : string =
 94 |         let chars = "abcdefghijklmnopqrstuvwxyz"
 95 | 
 96 |         let randomCharArray =
 97 |             Enumerable
 98 |                 .Repeat(chars, 8)
 99 |                 .Select(fun str -> str.[random.Next(str.Length)])
100 |                 .ToArray()
101 | 
102 |         String(randomCharArray)
103 | 
104 |     let private AddRemote (remoteName: string) (remoteUrl: string) =
105 |         let gitRemoteAdd =
106 |             {
107 |                 Command = gitCommand
108 |                 Arguments = sprintf "remote add %s %s" remoteName remoteUrl
109 |             }
110 | 
111 |         Process
112 |             .Execute(gitRemoteAdd, Echo.Off)
113 |             .UnwrapDefault()
114 |         |> ignore<string>
115 | 
116 |     let private RemoveRemote(remoteName: string) =
117 |         let gitRemoteRemove =
118 |             {
119 |                 Command = gitCommand
120 |                 Arguments = sprintf "remote remove %s" remoteName
121 |             }
122 | 
123 |         Process
124 |             .Execute(gitRemoteRemove, Echo.Off)
125 |             .UnwrapDefault()
126 |         |> ignore<string>
127 | 
128 |     let private GetRemotesInternal() =
129 |         let gitShowRemotes =
130 |             {
131 |                 Command = gitCommand
132 |                 Arguments = "remote -v"
133 |             }
134 | 
135 |         Process
136 |             .Execute(gitShowRemotes, Echo.Off)
137 |             .UnwrapDefault()
138 | 
139 |     let CheckRemotes() =
140 |         let gitRemoteVerbose =
141 |             {
142 |                 Command = gitCommand
143 |                 Arguments = "remote --verbose"
144 |             }
145 | 
146 |         let proc = Process.Execute(gitRemoteVerbose, Echo.Off)
147 |         let map = proc.UnwrapDefault() |> Misc.TsvParse
148 | 
149 |         let removedLastAction =
150 |             Map.map
151 |                 (fun (_key: string) (value: string) -> (value.Split(' ').[0]))
152 |                 map
153 | 
154 |         removedLastAction
155 | 
156 |     let private FetchAll() =
157 |         let gitFetchAll =
158 |             {
159 |                 Command = gitCommand
160 |                 Arguments = "fetch --all"
161 |             }
162 | 
163 |         Process
164 |             .Execute(gitFetchAll, Echo.Off)
165 |             .UnwrapDefault()
166 |         |> ignore<string>
167 | 
168 |     let GetRemotes() =
169 |         let remoteLines = GetRemotesInternal() |> Misc.TsvParse
170 | 
171 |         seq {
172 |             for KeyValue(remoteName, remoteUrl) in remoteLines do
173 |                 yield (remoteName, remoteUrl)
174 |         }
175 | 
176 |     let private GetNumberOfCommitsBehindAndAheadFromRemoteBranch
177 |         (repoUrl: string)
178 |         (branchName: string)
179 |         : int * int =
180 |         CheckGitIsInstalled()
181 | 
182 |         let lastCommit = GetLastCommit()
183 |         let remotes = GetRemotes()
184 | 
185 |         let maybeRemoteFound =
186 |             Seq.tryFind
187 |                 (fun (_, remoteUrl: string) -> remoteUrl.Contains repoUrl)
188 |                 remotes
189 | 
190 |         let remote, cleanRemoteLater =
191 |             match maybeRemoteFound with
192 |             | Some(remoteName, _) -> remoteName, false
193 |             | None ->
194 |                 let randomNameForRemoteToBeDeletedLater =
195 |                     GenerateRandomShortNameWithLettersButNoNumbers()
196 | 
197 |                 AddRemote randomNameForRemoteToBeDeletedLater repoUrl
198 |                 FetchAll()
199 |                 randomNameForRemoteToBeDeletedLater, true
200 | 
201 |         let gitRevListCmd =
202 |             {
203 |                 Command = gitCommand
204 |                 Arguments =
205 |                     sprintf
206 |                         "rev-list --left-right --count %s/%s...%s"
207 |                         remote
208 |                         branchName
209 |                         lastCommit
210 |             }
211 | 
212 |         let gitCommitDivergence = Process.Execute(gitRevListCmd, Echo.Off)
213 |         let output = gitCommitDivergence.UnwrapDefault()
214 | 
215 |         let numbers =
216 |             output.Split([| "\t" |], StringSplitOptions.RemoveEmptyEntries)
217 | 
218 |         let expectedNumberOfNumbers = 2
219 | 
220 |         if (numbers.Length <> expectedNumberOfNumbers) then
221 |             failwith(
222 |                 sprintf
223 |                     "Unexpected git output for special `git rev-list` command, got %d numbers instead of %d"
224 |                     numbers.Length
225 |                     expectedNumberOfNumbers
226 |             )
227 | 
228 |         let behind = Int32.Parse(numbers.[0])
229 |         let ahead = Int32.Parse(numbers.[1])
230 | 
231 |         if cleanRemoteLater then
232 |             RemoveRemote remote
233 | 
234 |         behind, ahead
235 | 
236 |     let GetNumberOfCommitsAhead repo branch : int =
237 |         GetNumberOfCommitsBehindAndAheadFromRemoteBranch repo branch |> snd
238 | 
239 |     let GetNumberOfCommitsBehind repo branch : int =
240 |         GetNumberOfCommitsBehindAndAheadFromRemoteBranch repo branch |> fst
241 | 
242 |     // 0 == last commit, 1 == second to last, and so on...
243 |     let GetCommitMessageOfLastCommitNumber(number: int) : string =
244 |         if (number < 0) then
245 |             failwith "Expected number param to be non-negative"
246 | 
247 |         CheckGitIsInstalled()
248 | 
249 |         let gitLogCmd =
250 |             {
251 |                 Command = gitCommand
252 |                 Arguments =
253 |                     String.Format(
254 |                         "log --skip={0} -1 --pretty=format:%b",
255 |                         number
256 |                     )
257 |             }
258 | 
259 |         let gitLastNCommit = Process.Execute(gitLogCmd, Echo.Off)
260 |         gitLastNCommit.UnwrapDefault()
261 | 
262 |     let GetCommitMessagesOfCommitsInThisBranchNotPresentInRemoteBranch
263 |         repo
264 |         branch
265 |         : seq<string> =
266 |         seq {
267 |             for i = 0 to (GetNumberOfCommitsAhead repo branch) - 1 do
268 |                 yield GetCommitMessageOfLastCommitNumber i
269 |         }
270 | 
271 |     let GetRepoInfo() =
272 |         if not(IsGitInstalled()) then
273 |             String.Empty
274 |         else
275 |             let gitLog =
276 |                 Process.Execute(
277 |                     {
278 |                         Command = "git"
279 |                         Arguments = "log --oneline"
280 |                     },
281 |                     Echo.Off
282 |                 )
283 | 
284 |             match gitLog.Result with
285 |             | ProcessResultState.Error _ -> String.Empty
286 |             | ProcessResultState.WarningsOrAmbiguous output ->
287 |                 output.PrintToConsole()
288 |                 Console.WriteLine()
289 |                 Console.Out.Flush()
290 |                 Console.Error.Flush()
291 | 
292 |                 failwith
293 |                     "Unexpected git behaviour, as `git log` succeeded with warnings? ^"
294 |             | ProcessResultState.Success _ ->
295 |                 let branch = GetCurrentBranch()
296 | 
297 |                 let gitLogCmd =
298 |                     {
299 |                         Command = "git"
300 |                         Arguments =
301 |                             "log --no-color --first-parent -n1 --pretty=format:%h"
302 |                     }
303 | 
304 |                 let gitLastCommit = Process.Execute(gitLogCmd, Echo.Off)
305 | 
306 |                 match gitLastCommit.Result with
307 |                 | ProcessResultState.Error(_, output) ->
308 |                     output.PrintToConsole()
309 |                     Console.WriteLine()
310 |                     Console.Out.Flush()
311 |                     Console.Error.Flush()
312 | 
313 |                     failwith
314 |                         "Unexpected git behaviour, as `git log` succeeded before but not now ^"
315 |                 | ProcessResultState.WarningsOrAmbiguous output ->
316 |                     output.PrintToConsole()
317 |                     Console.WriteLine()
318 |                     Console.Out.Flush()
319 |                     Console.Error.Flush()
320 | 
321 |                     failwith
322 |                         "Unexpected git behaviour, as `git log` succeeded before but now has warnings? ^"
323 |                 | ProcessResultState.Success output ->
324 |                     let lines = Misc.CrossPlatformStringSplitInLines output
325 | 
326 |                     if lines.Length <> 1 then
327 |                         failwith
328 |                             "Unexpected git output for special git log command"
329 |                     else
330 |                         let lastCommitSingleOutput = lines.[0]
331 |                         sprintf "(%s/%s)" branch lastCommitSingleOutput
332 | 
333 |     let GetTags() =
334 |         let tags =
335 |             Process
336 |                 .Execute(
337 |                     {
338 |                         Command = "git"
339 |                         Arguments = "tag"
340 |                     },
341 |                     Echo.All
342 |                 )
343 |                 .UnwrapDefault()
344 | 
345 |         let tagsSplitted =
346 |             tags.Split(
347 |                 [| "\r\n"; "\n" |],
348 |                 StringSplitOptions.RemoveEmptyEntries
349 |             )
350 | 
351 |         tagsSplitted
352 | 
353 |     let DoesTagExist(tagName: string) =
354 |         GetTags() |> Seq.contains tagName
355 | 
356 |     let CreateTag(tagName: string) =
357 |         Process
358 |             .Execute(
359 |                 {
360 |                     Command = "git"
361 |                     Arguments = (sprintf "tag %s" tagName)
362 |                 },
363 |                 Echo.All
364 |             )
365 |             .UnwrapDefault()
366 |         |> ignore<string>
367 | 
368 |         let processResultRemote =
369 |             Process.Execute(
370 |                 {
371 |                     Command = "git"
372 |                     Arguments = sprintf "push origin \"refs/tags/%s\"" tagName
373 |                 },
374 |                 Echo.All
375 |             )
376 | 
377 |         let _remoteResultRemote =
378 |             match processResultRemote.Result with
379 |             | ProcessResultState.Error(_exitCode, output) ->
380 |                 failwith(
381 |                     sprintf
382 |                         "pushing tags finished with an error: %s"
383 |                         output.StdErr
384 |                 )
385 |             | _ -> ()
386 | 
387 |         ()
388 | 
389 |     let CreateTagWithForce(tagName: string) =
390 |         Process
391 |             .Execute(
392 |                 {
393 |                     Command = "git"
394 |                     Arguments = sprintf "tag %s --force" tagName
395 |                 },
396 |                 Echo.All
397 |             )
398 |             .UnwrapDefault()
399 |         |> ignore<string>
400 | 
401 |         let processResultRemote =
402 |             Process.Execute(
403 |                 {
404 |                     Command = "git"
405 |                     Arguments =
406 |                         sprintf "push origin \"refs/tags/%s\" --force" tagName
407 |                 },
408 |                 Echo.All
409 |             )
410 | 
411 |         match processResultRemote.Result with
412 |         | ProcessResultState.Error(_exitCode, output) ->
413 |             failwithf "pushing tag finished with an error: %s" output.StdErr
414 |         | _ -> ()
415 | 
416 |     let DeleteTag tagName =
417 |         Process
418 |             .Execute(
419 |                 {
420 |                     Command = "git"
421 |                     Arguments = (sprintf "tag --delete %s" tagName)
422 |                 },
423 |                 Echo.All
424 |             )
425 |             .UnwrapDefault()
426 |         |> ignore<string>
427 | 
428 |         let processResultRemote =
429 |             Process.Execute(
430 |                 {
431 |                     Command = "git"
432 |                     Arguments = (sprintf "push --delete origin %s" tagName)
433 |                 },
434 |                 Echo.All
435 |             )
436 | 
437 |         let _processResultRemote =
438 |             match processResultRemote.Result with
439 |             | ProcessResultState.Error(_exitCode, output) ->
440 |                 failwith(
441 |                     sprintf
442 |                         "deleting remote tag finished with an error: %s"
443 |                         output.StdErr
444 |                 )
445 |             | _ -> ()
446 | 
447 |         ()
448 | 


--------------------------------------------------------------------------------
/Fsdk.Tests/AsyncExtensions.fs:
--------------------------------------------------------------------------------
  1 | namespace Fsdk.Tests
  2 | 
  3 | open System
  4 | open System.Diagnostics
  5 | 
  6 | open NUnit.Framework
  7 | 
  8 | open Fsdk
  9 | 
 10 | [<TestFixture>]
 11 | type AsyncExtensions() =
 12 | 
 13 |     [<Test>]
 14 |     member __.``basic test for WhenAny``() =
 15 |         let shortJobRes = 1
 16 |         let shortTime = TimeSpan.FromSeconds 1.
 17 | 
 18 |         let shortJob =
 19 |             async {
 20 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
 21 |                 return shortJobRes
 22 |             }
 23 | 
 24 |         let longJobRes = 2
 25 |         let longTime = TimeSpan.FromSeconds 10.
 26 | 
 27 |         let longJob =
 28 |             async {
 29 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
 30 |                 return longJobRes
 31 |             }
 32 | 
 33 |         let stopWatch = Stopwatch.StartNew()
 34 | 
 35 |         let res1 =
 36 |             FSharpUtil.AsyncExtensions.WhenAny [ longJob; shortJob ]
 37 |             |> Async.RunSynchronously
 38 | 
 39 |         Assert.That(res1, Is.EqualTo shortJobRes)
 40 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime)
 41 |         stopWatch.Stop()
 42 | 
 43 |         let stopWatch = Stopwatch.StartNew()
 44 | 
 45 |         let res2 =
 46 |             FSharpUtil.AsyncExtensions.WhenAny [ shortJob; longJob ]
 47 |             |> Async.RunSynchronously
 48 | 
 49 |         Assert.That(res2, Is.EqualTo shortJobRes)
 50 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime)
 51 |         stopWatch.Stop()
 52 | 
 53 |     [<Test>]
 54 |     member __.``basic test for Async.Choice``() =
 55 |         let shortTime = TimeSpan.FromSeconds 1.
 56 | 
 57 |         let shortFailingJob =
 58 |             async {
 59 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
 60 |                 return None
 61 |             }
 62 | 
 63 |         let shortSuccessfulJobRes = 2
 64 | 
 65 |         let shortSuccessfulJob =
 66 |             async {
 67 |                 do!
 68 |                     Async.Sleep(
 69 |                         int shortTime.TotalMilliseconds
 70 |                         + int shortTime.TotalMilliseconds
 71 |                     )
 72 | 
 73 |                 return Some shortSuccessfulJobRes
 74 |             }
 75 | 
 76 |         let longJobRes = 3
 77 |         let longTime = TimeSpan.FromSeconds 10.
 78 | 
 79 |         let longJob =
 80 |             async {
 81 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
 82 |                 return Some longJobRes
 83 |             }
 84 | 
 85 |         let stopWatch = Stopwatch.StartNew()
 86 | 
 87 |         let res1 =
 88 |             Async.Choice
 89 |                 [
 90 |                     longJob
 91 |                     shortFailingJob
 92 |                     shortSuccessfulJob
 93 |                 ]
 94 |             |> Async.RunSynchronously
 95 | 
 96 |         Assert.That(res1, Is.EqualTo(Some shortSuccessfulJobRes))
 97 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#1")
 98 |         stopWatch.Stop()
 99 | 
100 |         let stopWatch = Stopwatch.StartNew()
101 | 
102 |         let res2 =
103 |             Async.Choice
104 |                 [
105 |                     longJob
106 |                     shortSuccessfulJob
107 |                     shortFailingJob
108 |                 ]
109 |             |> Async.RunSynchronously
110 | 
111 |         Assert.That(res2, Is.EqualTo(Some shortSuccessfulJobRes))
112 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#2")
113 |         stopWatch.Stop()
114 | 
115 |         let stopWatch = Stopwatch.StartNew()
116 | 
117 |         let res3 =
118 |             Async.Choice
119 |                 [
120 |                     shortFailingJob
121 |                     longJob
122 |                     shortSuccessfulJob
123 |                 ]
124 |             |> Async.RunSynchronously
125 | 
126 |         Assert.That(res3, Is.EqualTo(Some shortSuccessfulJobRes))
127 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#3")
128 |         stopWatch.Stop()
129 | 
130 |         let stopWatch = Stopwatch.StartNew()
131 | 
132 |         let res4 =
133 |             Async.Choice
134 |                 [
135 |                     shortFailingJob
136 |                     shortSuccessfulJob
137 |                     longJob
138 |                 ]
139 |             |> Async.RunSynchronously
140 | 
141 |         Assert.That(res4, Is.EqualTo(Some shortSuccessfulJobRes))
142 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#4")
143 |         stopWatch.Stop()
144 | 
145 |         let stopWatch = Stopwatch.StartNew()
146 | 
147 |         let res5 =
148 |             Async.Choice
149 |                 [
150 |                     shortSuccessfulJob
151 |                     longJob
152 |                     shortFailingJob
153 |                 ]
154 |             |> Async.RunSynchronously
155 | 
156 |         Assert.That(res5, Is.EqualTo(Some shortSuccessfulJobRes))
157 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#5")
158 |         stopWatch.Stop()
159 | 
160 |         let stopWatch = Stopwatch.StartNew()
161 | 
162 |         let res6 =
163 |             Async.Choice
164 |                 [
165 |                     shortSuccessfulJob
166 |                     shortFailingJob
167 |                     longJob
168 |                 ]
169 |             |> Async.RunSynchronously
170 | 
171 |         Assert.That(res6, Is.EqualTo(Some shortSuccessfulJobRes))
172 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime, "time#6")
173 |         stopWatch.Stop()
174 | 
175 |     [<Test>]
176 |     member __.``basic test for WhenAnyAndAll``() =
177 |         let lockObj = Object()
178 |         let mutable asyncJobsPerformedCount = 0
179 | 
180 |         let shortJobRes = 1
181 |         let shortTime = TimeSpan.FromSeconds 2.
182 | 
183 |         let shortJob =
184 |             async {
185 |                 lock
186 |                     lockObj
187 |                     (fun _ ->
188 |                         asyncJobsPerformedCount <- asyncJobsPerformedCount + 1
189 |                     )
190 | 
191 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
192 |                 return shortJobRes
193 |             }
194 | 
195 |         let longJobRes = 2
196 |         let longTime = TimeSpan.FromSeconds 3.
197 | 
198 |         let longJob =
199 |             async {
200 |                 lock
201 |                     lockObj
202 |                     (fun _ ->
203 |                         asyncJobsPerformedCount <- asyncJobsPerformedCount + 1
204 |                     )
205 | 
206 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
207 |                 return longJobRes
208 |             }
209 | 
210 |         let stopWatch = Stopwatch.StartNew()
211 | 
212 |         let subJobs =
213 |             FSharpUtil.AsyncExtensions.WhenAnyAndAll [ longJob; shortJob ]
214 |             |> Async.RunSynchronously
215 | 
216 |         let timingErrorMargin = TimeSpan.FromMilliseconds 10.0
217 |         Assert.That(stopWatch.Elapsed, Is.LessThan longTime)
218 | 
219 |         Assert.That(
220 |             stopWatch.Elapsed,
221 |             Is.GreaterThan(shortTime - timingErrorMargin)
222 |         )
223 | 
224 |         let results = subJobs |> Async.RunSynchronously
225 |         Assert.That(results.Length, Is.EqualTo 2)
226 |         Assert.That(results.[0], Is.EqualTo longJobRes)
227 |         Assert.That(results.[1], Is.EqualTo shortJobRes)
228 |         stopWatch.Stop()
229 | 
230 |         Assert.That(asyncJobsPerformedCount, Is.EqualTo 2)
231 | 
232 |         // the below is to make sure that the jobs don't get executed a second time!
233 |         let stopWatch = Stopwatch.StartNew()
234 |         subJobs |> Async.RunSynchronously |> ignore<array<int>>
235 |         Assert.That(asyncJobsPerformedCount, Is.EqualTo 2)
236 |         Assert.That(stopWatch.Elapsed, Is.LessThan shortTime)
237 | 
238 |     [<Test>]
239 |     member __.``AsyncParallel cancels all jobs if there's an exception in one'``
240 |         ()
241 |         =
242 |         let shortTime = TimeSpan.FromSeconds 2.
243 | 
244 |         let shortJob =
245 |             async {
246 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
247 |                 return failwith "pepe"
248 |             }
249 | 
250 |         let longJobRes = 2
251 |         let mutable longJobFinished = false
252 |         let longTime = TimeSpan.FromSeconds 3.
253 | 
254 |         let longJob =
255 |             async {
256 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
257 |                 longJobFinished <- true
258 |                 return longJobRes
259 |             }
260 | 
261 |         let result =
262 |             try
263 |                 Async.Parallel [ longJob; shortJob ]
264 |                 |> Async.RunSynchronously
265 |                 |> Some
266 |             with
267 |             | _ -> None
268 | 
269 |         Assert.That(result, Is.EqualTo None)
270 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
271 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
272 |         Assert.That(longJobFinished, Is.EqualTo false, "#after")
273 | 
274 |     [<Test>]
275 |     member __.``AsyncChoice cancels slower jobs (all jobs that were not the fastest)``
276 |         ()
277 |         =
278 |         let shortJobRes = 1
279 |         let shortTime = TimeSpan.FromSeconds 2.
280 | 
281 |         let shortJob =
282 |             async {
283 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
284 |                 return Some shortJobRes
285 |             }
286 | 
287 |         let longJobRes = 2
288 |         let mutable longJobFinished = false
289 |         let longTime = TimeSpan.FromSeconds 3.
290 | 
291 |         let longJob =
292 |             async {
293 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
294 |                 longJobFinished <- true
295 |                 return Some longJobRes
296 |             }
297 | 
298 |         let result =
299 |             Async.Choice [ longJob; shortJob ] |> Async.RunSynchronously
300 | 
301 |         Assert.That(result, Is.EqualTo(Some shortJobRes))
302 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
303 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
304 |         Assert.That(longJobFinished, Is.EqualTo false, "#after")
305 | 
306 |     [<Test>]
307 |     member __.``AsyncExtensions-WhenAny cancels slower jobs (all jobs that were not the fastest)``
308 |         ()
309 |         =
310 |         let shortJobRes = 1
311 |         let shortTime = TimeSpan.FromSeconds 2.
312 | 
313 |         let shortJob =
314 |             async {
315 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
316 |                 return shortJobRes
317 |             }
318 | 
319 |         let longJobRes = 2
320 |         let mutable longJobFinished = false
321 |         let longTime = TimeSpan.FromSeconds 3.
322 | 
323 |         let longJob =
324 |             async {
325 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
326 |                 longJobFinished <- true
327 |                 return longJobRes
328 |             }
329 | 
330 |         let result =
331 |             FSharpUtil.AsyncExtensions.WhenAny [ longJob; shortJob ]
332 |             |> Async.RunSynchronously
333 | 
334 |         Assert.That(result, Is.EqualTo shortJobRes)
335 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
336 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
337 |         Assert.That(longJobFinished, Is.EqualTo false, "#after")
338 | 
339 |     [<Test>]
340 |     member __.``AsyncExtensions-WhenAnyAndAll doesn't cancel slower jobs``() =
341 |         let shortJobRes = 1
342 |         let shortTime = TimeSpan.FromSeconds 2.
343 | 
344 |         let shortJob =
345 |             async {
346 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
347 |                 return shortJobRes
348 |             }
349 | 
350 |         let longJobRes = 2
351 |         let mutable longJobFinished = false
352 |         let longTime = TimeSpan.FromSeconds 3.
353 | 
354 |         let longJob =
355 |             async {
356 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
357 |                 longJobFinished <- true
358 |                 return longJobRes
359 |             }
360 | 
361 |         let jobs =
362 |             FSharpUtil.AsyncExtensions.WhenAnyAndAll [ longJob; shortJob ]
363 |             |> Async.RunSynchronously
364 | 
365 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
366 |         let results = jobs |> Async.RunSynchronously
367 |         Assert.That(results.[0], Is.EqualTo longJobRes)
368 |         Assert.That(results.[1], Is.EqualTo shortJobRes)
369 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
370 |         Assert.That(longJobFinished, Is.EqualTo true, "#after")
371 | 
372 |     [<Test>]
373 |     member __.``Async.MixedParallel2 cancels all jobs if there's an exception in one'``
374 |         ()
375 |         =
376 |         let shortTime = TimeSpan.FromSeconds 2.
377 | 
378 |         let shortJob =
379 |             async {
380 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
381 |                 return failwith "pepe"
382 |             }
383 | 
384 |         let mutable longJobFinished = false
385 |         let longTime = TimeSpan.FromSeconds 3.
386 | 
387 |         let longJob =
388 |             async {
389 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
390 |                 longJobFinished <- true
391 |                 return 1
392 |             }
393 | 
394 |         let result =
395 |             try
396 |                 FSharpUtil.AsyncExtensions.MixedParallel2 longJob shortJob
397 |                 |> Async.RunSynchronously
398 |                 |> Some
399 |             with
400 |             | _ -> None
401 | 
402 |         Assert.That(result, Is.EqualTo None)
403 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
404 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
405 |         Assert.That(longJobFinished, Is.EqualTo false, "#after")
406 | 
407 |     [<Test>]
408 |     member __.``Async.MixedParallel3 cancels all jobs if there's an exception in one'``
409 |         ()
410 |         =
411 |         let shortTime = TimeSpan.FromSeconds 2.
412 | 
413 |         let shortJob =
414 |             async {
415 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
416 |                 return failwith "pepe"
417 |             }
418 | 
419 | 
420 |         let longTime = TimeSpan.FromSeconds 3.
421 | 
422 |         let mutable longJobFinished = false
423 | 
424 |         let longJob =
425 |             async {
426 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
427 |                 longJobFinished <- true
428 |                 return 1
429 |             }
430 | 
431 |         let mutable longJob2Finished = false
432 | 
433 |         let longJob2 =
434 |             async {
435 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
436 |                 longJobFinished <- true
437 |                 return 2.0
438 |             }
439 | 
440 |         let result =
441 |             try
442 |                 FSharpUtil.AsyncExtensions.MixedParallel3
443 |                     longJob
444 |                     shortJob
445 |                     longJob2
446 |                 |> Async.RunSynchronously
447 |                 |> Some
448 |             with
449 |             | _ -> None
450 | 
451 |         Assert.That(result, Is.EqualTo None)
452 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
453 |         Assert.That(longJob2Finished, Is.EqualTo false, "#before")
454 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
455 |         Assert.That(longJobFinished, Is.EqualTo false, "#after")
456 |         Assert.That(longJob2Finished, Is.EqualTo false, "#before")
457 | 
458 |     [<Test>]
459 |     member __.``Async.MixedParallel4 cancels all jobs if there's an exception in one'``
460 |         ()
461 |         =
462 |         let shortTime = TimeSpan.FromSeconds 2.
463 | 
464 |         let shortJob =
465 |             async {
466 |                 do! Async.Sleep(int shortTime.TotalMilliseconds)
467 |                 return failwith "pepe"
468 |             }
469 | 
470 |         let longTime = TimeSpan.FromSeconds 3.
471 | 
472 |         let mutable longJobFinished = false
473 | 
474 |         let longJob =
475 |             async {
476 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
477 |                 longJobFinished <- true
478 |                 return 1
479 |             }
480 | 
481 |         let mutable longJob2Finished = false
482 | 
483 |         let longJob2 =
484 |             async {
485 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
486 |                 longJobFinished <- true
487 |                 return 2.1m
488 |             }
489 | 
490 |         let mutable longJob3Finished = false
491 | 
492 |         let longJob3 =
493 |             async {
494 |                 do! Async.Sleep(int longTime.TotalMilliseconds)
495 |                 longJobFinished <- true
496 |                 return 3.1f
497 |             }
498 | 
499 |         let result =
500 |             try
501 |                 FSharpUtil.AsyncExtensions.MixedParallel4
502 |                     longJob
503 |                     shortJob
504 |                     longJob2
505 |                     longJob3
506 |                 |> Async.RunSynchronously
507 |                 |> Some
508 |             with
509 |             | _ -> None
510 | 
511 |         Assert.That(result, Is.EqualTo None)
512 |         Assert.That(longJobFinished, Is.EqualTo false, "#before")
513 |         Assert.That(longJob2Finished, Is.EqualTo false, "#before - 2")
514 |         Assert.That(longJob3Finished, Is.EqualTo false, "#before - 3")
515 |         Threading.Thread.Sleep(TimeSpan.FromSeconds 7.0)
516 |         Assert.That(longJobFinished, Is.EqualTo false, "#after")
517 |         Assert.That(longJob2Finished, Is.EqualTo false, "#after - 2")
518 |         Assert.That(longJob3Finished, Is.EqualTo false, "#after - 3")
519 | 


--------------------------------------------------------------------------------