Builder (Polyglot)¶

In [ ]:
#r @"../../../../../../../.nuget/packages/fsharp.control.asyncseq/3.2.1/lib/netstandard2.1/FSharp.Control.AsyncSeq.dll"
#r @"../../../../../../../.nuget/packages/system.reactive/6.0.1-preview.1/lib/net6.0/System.Reactive.dll"
#r @"../../../../../../../.nuget/packages/system.reactive.linq/6.0.1-preview.1/lib/netstandard2.0/System.Reactive.Linq.dll"
#r @"../../../../../../../.nuget/packages/argu/6.2.4/lib/netstandard2.0/Argu.dll"
In [ ]:
#!import ../../lib/fsharp/Notebooks.dib
#!import ../../lib/fsharp/Testing.dib
In [ ]:
#!import ../../lib/fsharp/Common.fs
#!import ../../lib/fsharp/CommonFSharp.fs
#!import ../../lib/fsharp/Async.fs
#!import ../../lib/fsharp/AsyncSeq.fs
#!import ../../lib/fsharp/Runtime.fs
#!import ../../lib/fsharp/FileSystem.fs
In [ ]:
#if !INTERACTIVE
open Lib
#endif
In [ ]:
open Common
open SpiralFileSystem.Operators

buildProject¶

In [ ]:
let inline buildProject runtime outputDir path = async {
    let fullPath = path |> System.IO.Path.GetFullPath
    let fileDir = fullPath |> System.IO.Path.GetDirectoryName
    let extension = fullPath |> System.IO.Path.GetExtension

    trace Debug
        (fun () -> "buildProject")
        (fun () -> $"fullPath: {fullPath} / {_locals ()}")

    match extension with
    | ".fsproj" -> ()
    | _ -> failwith "Invalid project file"

    let runtimes =
        runtime
        |> Option.map List.singleton
        |> Option.defaultValue [ "linux-x64"; "win-x64" ]

    let outputDir = outputDir |> Option.defaultValue "dist"

    let! exitCodes =
        runtimes
        |> List.map (fun runtime -> async {
            let command = $@"dotnet publish ""{fullPath}"" --configuration Release --output ""{outputDir}"" --runtime {runtime}"
            let! exitCode, _result =
                SpiralRuntime.execution_options (fun x ->
                    { x with
                        l0 = command
                        l6 = Some fileDir
                    }
                )
                |> SpiralRuntime.execute_with_options_async
            return exitCode
        })
        |> Async.Sequential
        |> Async.map Array.sum

    if "CI" |> System.Environment.GetEnvironmentVariable |> System.String.IsNullOrEmpty |> not then
        do! fileDir </> "bin" |> SpiralFileSystem.delete_directory_async |> Async.Ignore
        do! fileDir </> "obj" |> SpiralFileSystem.delete_directory_async |> Async.Ignore

    return exitCodes
}

persistCodeProject¶

In [ ]:
let inline persistCodeProject packages modules name hash code = async {
    trace Debug
        (fun () -> "persistCodeProject")
        (fun () -> $"packages: {packages} / modules: {modules} / name: {name} / hash: {hash} / code.Length: {code |> String.length} / {_locals ()}")

    let workspaceRoot = SpiralFileSystem.get_workspace_root ()

    let targetDir =
        let targetDir = workspaceRoot </> "target/Builder" </> name
        match hash with
        | Some hash -> targetDir </> "packages" </> hash
        | None -> targetDir
    targetDir |> System.IO.Directory.CreateDirectory |> ignore

    let filePath = targetDir </> $"{name}.fs" |> System.IO.Path.GetFullPath
    do! code |> SpiralFileSystem.write_all_text_exists filePath

    let modulesCode =
        modules
        |> List.map (fun path -> $"""<Compile Include="{workspaceRoot </> path}" />""")
        |> SpiralSm.concat "\n        "

    let fsprojPath = targetDir </> $"{name}.fsproj"
    let fsprojCode = $"""<Project Sdk="Microsoft.NET.Sdk">
    <PropertyGroup>
        <TargetFramework>net9.0</TargetFramework>
        <LangVersion>preview</LangVersion>
        <RollForward>Major</RollForward>
        <TargetLatestRuntimePatch>true</TargetLatestRuntimePatch>
        <ServerGarbageCollection>true</ServerGarbageCollection>
        <ConcurrentGarbageCollection>true</ConcurrentGarbageCollection>
        <PublishAot>false</PublishAot>
        <PublishTrimmed>false</PublishTrimmed>
        <PublishSingleFile>true</PublishSingleFile>
        <SelfContained>true</SelfContained>
        <Version>0.0.1-alpha.1</Version>
        <OutputType>Exe</OutputType>
    </PropertyGroup>

    <PropertyGroup Condition="$([MSBuild]::IsOSPlatform('FreeBSD'))">
        <DefineConstants>_FREEBSD</DefineConstants>
    </PropertyGroup>

    <PropertyGroup Condition="$([MSBuild]::IsOSPlatform('Linux'))">
        <DefineConstants>_LINUX</DefineConstants>
    </PropertyGroup>

    <PropertyGroup Condition="$([MSBuild]::IsOSPlatform('OSX'))">
        <DefineConstants>_OSX</DefineConstants>
    </PropertyGroup>

    <PropertyGroup Condition="$([MSBuild]::IsOSPlatform('Windows'))">
        <DefineConstants>_WINDOWS</DefineConstants>
    </PropertyGroup>

    <ItemGroup>
        {modulesCode}
        <Compile Include="{filePath}" />
    </ItemGroup>

    <ItemGroup>
        <FrameworkReference Include="Microsoft.AspNetCore.App" />
    </ItemGroup>

    <Import Project="{workspaceRoot}/.paket/Paket.Restore.targets" />
</Project>
"""
    do! fsprojCode |> SpiralFileSystem.write_all_text_exists fsprojPath

    let paketReferencesPath = targetDir </> "paket.references"
    let paketReferencesCode =
        "FSharp.Core" :: packages
        |> SpiralSm.concat "\n"
    do! paketReferencesCode |> SpiralFileSystem.write_all_text_exists paketReferencesPath

    return fsprojPath
}

buildCode¶

In [ ]:
let inline buildCode runtime packages modules outputDir name code = async {
    let! fsprojPath = code |> persistCodeProject packages modules name None
    let! exitCode = fsprojPath |> buildProject runtime outputDir
    if exitCode <> 0 then
        trace Critical
            (fun () -> "buildCode")
            (fun () -> $"code: {code |> SpiralSm.ellipsis_end 400} / {_locals ()}")
    return exitCode
}
In [ ]:
//// test

"1 + 1 |> ignore"
|> buildCode None [] [] None "test1"
|> Async.runWithTimeout 180000
|> _assertEqual (Some 0)
00:00:01 d #1 persistCodeProject / packages: [] / modules: [] / name: test1 / hash:  / code.Length: 15
00:00:01 d #2 buildProject / fullPath: /home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj
00:00:03 d #1 runtime.execute_with_options_async / { file_name = dotnet; arguments = US5_0
  "publish "/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj" --configuration Release --output "dist" --runtime linux-x64"; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj" --configuration Release --output "dist" --runtime linux-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test1"; stderr = true } }
00:00:04 v #2 >   Determining projects to restore...
00:00:04 v #3 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:04 v #4 >   The last full restore is still up to date. Nothing left to do.
00:00:04 v #5 >   Total time taken: 0 milliseconds
00:00:04 v #6 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:05 v #7 >   Restoring /home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj
00:00:05 v #8 >   Starting restore process.
00:00:05 v #9 >   Total time taken: 0 milliseconds
00:00:05 v #10 >   Restored /home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj (in 285 ms).
00:00:07 v #11 > /home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fs(1,16): warning FS0988: Main module of program is empty: nothing will happen when it is run [/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj]
00:00:08 v #12 >   test1 -> /home/runner/work/polyglot/polyglot/target/Builder/test1/bin/Release/net9.0/linux-x64/test1.dll
00:00:09 v #13 >   test1 -> /home/runner/work/polyglot/polyglot/target/Builder/test1/dist
00:00:09 d #14 runtime.execute_with_options_async / { exit_code = 0; output_length = 911; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj" --configuration Release --output "dist" --runtime linux-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test1"; stderr = true } }
00:00:09 d #15 runtime.execute_with_options_async / { file_name = dotnet; arguments = US5_0
  "publish "/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj" --configuration Release --output "dist" --runtime win-x64"; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj" --configuration Release --output "dist" --runtime win-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test1"; stderr = true } }
00:00:09 v #16 >   Determining projects to restore...
00:00:09 v #17 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:09 v #18 >   The last full restore is still up to date. Nothing left to do.
00:00:09 v #19 >   Total time taken: 0 milliseconds
00:00:10 v #20 >   Restored /home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj (in 240 ms).
00:00:12 v #21 > /home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fs(1,16): warning FS0988: Main module of program is empty: nothing will happen when it is run [/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj]
00:00:12 v #22 >   test1 -> /home/runner/work/polyglot/polyglot/target/Builder/test1/bin/Release/net9.0/win-x64/test1.dll
00:00:13 v #23 >   test1 -> /home/runner/work/polyglot/polyglot/target/Builder/test1/dist
00:00:13 d #24 runtime.execute_with_options_async / { exit_code = 0; output_length = 701; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test1/test1.fsproj" --configuration Release --output "dist" --runtime win-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test1"; stderr = true } }
Some 0

In [ ]:
//// test

"1 + a |> ignore"
|> buildCode None [] [] None "test2"
|> Async.runWithTimeout 180000
|> _assertEqual (Some 2)
00:00:11 d #3 persistCodeProject / packages: [] / modules: [] / name: test2 / hash:  / code.Length: 15
00:00:11 d #4 buildProject / fullPath: /home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj
00:00:13 d #25 runtime.execute_with_options_async / { file_name = dotnet; arguments = US5_0
  "publish "/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj" --configuration Release --output "dist" --runtime linux-x64"; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj" --configuration Release --output "dist" --runtime linux-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test2"; stderr = true } }
00:00:14 v #26 >   Determining projects to restore...
00:00:14 v #27 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:14 v #28 >   The last full restore is still up to date. Nothing left to do.
00:00:14 v #29 >   Total time taken: 0 milliseconds
00:00:14 v #30 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:15 v #31 >   Restoring /home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj
00:00:15 v #32 >   Starting restore process.
00:00:15 v #33 >   Total time taken: 0 milliseconds
00:00:15 v #34 >   Restored /home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj (in 238 ms).
00:00:17 v #35 > /home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fs(1,5): error FS0039: The value or constructor 'a' is not defined. [/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj]
00:00:17 d #36 runtime.execute_with_options_async / { exit_code = 1; output_length = 704; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj" --configuration Release --output "dist" --runtime linux-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test2"; stderr = true } }
00:00:17 d #37 runtime.execute_with_options_async / { file_name = dotnet; arguments = US5_0
  "publish "/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj" --configuration Release --output "dist" --runtime win-x64"; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj" --configuration Release --output "dist" --runtime win-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test2"; stderr = true } }
00:00:17 v #38 >   Determining projects to restore...
00:00:18 v #39 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:18 v #40 >   The last full restore is still up to date. Nothing left to do.
00:00:18 v #41 >   Total time taken: 0 milliseconds
00:00:18 v #42 >   Restored /home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj (in 261 ms).
00:00:20 v #43 > /home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fs(1,5): error FS0039: The value or constructor 'a' is not defined. [/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj]
00:00:20 d #44 runtime.execute_with_options_async / { exit_code = 1; output_length = 496; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/test2/test2.fsproj" --configuration Release --output "dist" --runtime win-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/test2"; stderr = true } }
00:00:18 c #5 buildCode / code: 1 + a |> ignore
Some 2

readFile¶

In [ ]:
let inline readFile path = async {
    let! code = path |> SpiralFileSystem.read_all_text_async

    let code = System.Text.RegularExpressions.Regex.Replace (
        code,
        @"( *)(let\s+main\s+\w+\s*=)",
        fun m -> m.Groups.[1].Value + "[<EntryPoint>]\n" + m.Groups.[1].Value + m.Groups.[2].Value
    )

    let codeTrim = code |> SpiralSm.trim_end [||]
    return
        if codeTrim |> SpiralSm.ends_with "\n()"
        then codeTrim |> SpiralSm.slice 0 ((codeTrim |> String.length) - 3)
        else code
}

buildFile¶

In [ ]:
let inline buildFile runtime packages modules path = async {
    let fullPath = path |> System.IO.Path.GetFullPath
    let dir = fullPath |> System.IO.Path.GetDirectoryName
    let name = fullPath |> System.IO.Path.GetFileNameWithoutExtension
    let! code = fullPath |> readFile
    return! code |> buildCode runtime packages modules (dir </> "dist" |> Some) name
}

persistFile¶

In [ ]:
let inline persistFile packages modules path = async {
    let fullPath = path |> System.IO.Path.GetFullPath
    let name = fullPath |> System.IO.Path.GetFileNameWithoutExtension
    let! code = fullPath |> readFile
    return! code |> persistCodeProject packages modules name None
}

Arguments¶

In [ ]:
[<RequireQualifiedAccess>]
type Arguments =
    | [<Argu.ArguAttributes.MainCommand; Argu.ArguAttributes.ExactlyOnce>] Path of path : string
    | [<Argu.ArguAttributes.Unique>] Packages of packages : string list
    | [<Argu.ArguAttributes.Unique>] Modules of modules : string list
    | [<Argu.ArguAttributes.Unique>] Runtime of runtime : string
    | [<Argu.ArguAttributes.Unique>] Persist_Only

    interface Argu.IArgParserTemplate with
        member s.Usage =
            match s with
            | Path _ -> nameof Path
            | Packages _ -> nameof Packages
            | Modules _ -> nameof Modules
            | Runtime _ -> nameof Runtime
            | Persist_Only -> nameof Persist_Only
In [ ]:
//// test

Argu.ArgumentParser.Create<Arguments>().PrintUsage ()
"USAGE: dotnet-repl [--help] [--packages [<packages>...]]
                   [--modules [<modules>...]] [--runtime <runtime>]
                   [--persist-only] <path>

PATH:

    <path>                Path

OPTIONS:

    --packages [<packages>...]
                          Packages
    --modules [<modules>...]
                          Modules
    --runtime <runtime>   Runtime
    --persist-only        Persist_Only
    --help                display this list of options.
"

main¶

In [ ]:
let main args =
    let argsMap = args |> Runtime.parseArgsMap<Arguments>

    let path =
        match argsMap.[nameof Arguments.Path] with
        | [ Arguments.Path path ] -> Some path
        | _ -> None
        |> Option.get

    let packages =
        match argsMap |> Map.tryFind (nameof Arguments.Packages) with
        | Some [ Arguments.Packages packages ] -> packages
        | _ -> []

    let modules =
        match argsMap |> Map.tryFind (nameof Arguments.Modules) with
        | Some [ Arguments.Modules modules ] -> modules
        | _ -> []

    let runtime =
        match argsMap |> Map.tryFind (nameof Arguments.Runtime) with
        | Some [ Arguments.Runtime runtime ] -> Some runtime
        | _ -> None

    let persistOnly = argsMap |> Map.containsKey (nameof Arguments.Persist_Only)

    if persistOnly
    then path |> persistFile packages modules |> Async.map (fun _ -> 0)
    else path |> buildFile runtime packages modules
    |> Async.runWithTimeout (60001 * 60 * 24)
    |> function
        | Some exitCode -> exitCode
        | None -> 1
In [ ]:
//// test

let args =
    System.Environment.GetEnvironmentVariable "ARGS"
    |> SpiralRuntime.split_args
    |> Result.toArray
    |> Array.collect id

match args with
| [||] -> 0
| args -> if main args = 0 then 0 else failwith "main failed"
0
00:00:18 d #6 persistCodeProject / packages: [Argu; FSharp.Control.AsyncSeq; System.Reactive.Linq] / modules: [deps/spiral/lib/spiral/common.fsx; deps/spiral/lib/spiral/sm.fsx; deps/spiral/lib/spiral/crypto.fsx; ... ] / name: Builder / hash:  / code.Length: 8673
00:00:18 d #7 buildProject / fullPath: /home/runner/work/polyglot/polyglot/target/Builder/Builder/Builder.fsproj
00:00:20 d #45 runtime.execute_with_options_async / { file_name = dotnet; arguments = US5_0
  "publish "/home/runner/work/polyglot/polyglot/target/Builder/Builder/Builder.fsproj" --configuration Release --output "/home/runner/work/polyglot/polyglot/apps/builder/dist" --runtime linux-x64"; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/Builder/Builder.fsproj" --configuration Release --output "/home/runner/work/polyglot/polyglot/apps/builder/dist" --runtime linux-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/Builder"; stderr = true } }
00:00:21 v #46 >   Determining projects to restore...
00:00:21 v #47 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:21 v #48 >   The last full restore is still up to date. Nothing left to do.
00:00:21 v #49 >   Total time taken: 0 milliseconds
00:00:22 v #50 >   Paket version 9.0.2+a9b12aaeb8d8d5e47a415a3442b7920ed04e98e0
00:00:22 v #51 >   Restoring /home/runner/work/polyglot/polyglot/target/Builder/Builder/Builder.fsproj
00:00:22 v #52 >   Starting restore process.
00:00:22 v #53 >   Total time taken: 0 milliseconds
00:00:23 v #54 >   Restored /home/runner/work/polyglot/polyglot/target/Builder/Builder/Builder.fsproj (in 260 ms).
00:00:34 v #55 >   Builder -> /home/runner/work/polyglot/polyglot/target/Builder/Builder/bin/Release/net9.0/linux-x64/Builder.dll
00:00:34 v #56 >   Builder -> /home/runner/work/polyglot/polyglot/apps/builder/dist
00:00:34 d #57 runtime.execute_with_options_async / { exit_code = 0; output_length = 690; options = { command = dotnet publish "/home/runner/work/polyglot/polyglot/target/Builder/Builder/Builder.fsproj" --configuration Release --output "/home/runner/work/polyglot/polyglot/apps/builder/dist" --runtime linux-x64; cancellation_token = None; environment_variables = [||]; on_line = None; stdin = None; trace = true; working_directory = Some "/home/runner/work/polyglot/polyglot/target/Builder/Builder"; stderr = true } }