diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index c76dd425..41785cec 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -7,6 +7,12 @@ "commands": [ "paket" ] + }, + "fantomas": { + "version": "6.2.3", + "commands": [ + "fantomas" + ] } } -} +} \ No newline at end of file diff --git a/Content/default/Build.fs b/Content/default/Build.fs index 47d2cb0e..17e4f4cf 100644 --- a/Content/default/Build.fs +++ b/Content/default/Build.fs @@ -1,78 +1,105 @@ -open Fake.Core -open Fake.IO open Farmer open Farmer.Builders +open Fun.Build +open Fun.Result +open System.IO +open type System.IO.Path -open Helpers - -initializeContext () - -let sharedPath = Path.getFullName "src/Shared" -let serverPath = Path.getFullName "src/Server" -let clientPath = Path.getFullName "src/Client" -let deployPath = Path.getFullName "deploy" -let sharedTestsPath = Path.getFullName "tests/Shared" -let serverTestsPath = Path.getFullName "tests/Server" -let clientTestsPath = Path.getFullName "tests/Client" - -Target.create "Clean" (fun _ -> - Shell.cleanDir deployPath - run dotnet [ "fable"; "clean"; "--yes" ] clientPath // Delete *.fs.js files created by Fable -) - -Target.create "InstallClient" (fun _ -> run npm [ "install" ] ".") - -Target.create "Bundle" (fun _ -> - [ - "server", dotnet [ "publish"; "-c"; "Release"; "-o"; deployPath ] serverPath - "client", dotnet [ "fable"; "-o"; "output"; "-s"; "--run"; "npx"; "vite"; "build" ] clientPath - ] - |> runParallel) - -Target.create "Azure" (fun _ -> - let web = webApp { - name "SAFE-App" - operating_system OS.Linux - runtime_stack (DotNet "8.0") - zip_deploy "deploy" +[] +let main _ = + let serverPath = GetFullPath "src/Server" + let clientPath = GetFullPath "src/Client" + + pipeline "Test" { + description "Runs all tests" + + stage "Build Shared Tests Component" { run $"""dotnet build {GetFullPath "tests/Shared"}""" } + + stage "Run Tests" { + paralle + + stage "Server Tests" { run $"""dotnet watch run --project {GetFullPath "tests/Server"}""" } + + stage "Client Tests" { + run $"""dotnet fable watch -o output -s --cwd {GetFullPath "tests/Client"} --run npx vite""" + } + } + + runIfOnlySpecified // custom pipeline - dotnet run -- -p Test } - let deployment = arm { - location Location.WestEurope - add_resource web + pipeline "Format" { + description "Formats all code using Fantomas" + stage "format" { run "dotnet fantomas ." } + runIfOnlySpecified // custom pipeline - dotnet run -- -p Format } - deployment |> Deploy.execute "SAFE-App" Deploy.NoParameters |> ignore) + pipeline "Bundle" { + description "Builds and packages the app for production" -Target.create "Run" (fun _ -> - run dotnet [ "build" ] sharedPath + stage "Build" { + paralle - [ - "server", dotnet [ "watch"; "run" ] serverPath - "client", dotnet [ "fable"; "watch"; "-o"; "output"; "-s"; "--run"; "npx"; "vite" ] clientPath - ] - |> runParallel) + stage "Server" { + run (fun ctx -> asyncResult { + let deployPath = GetFullPath "deploy" -Target.create "RunTests" (fun _ -> - run dotnet [ "build" ] sharedTestsPath + if Directory.Exists deployPath then + Directory.Delete(deployPath, true) - [ - "server", dotnet [ "watch"; "run" ] serverTestsPath - "client", dotnet [ "fable"; "watch"; "-o"; "output"; "-s"; "--run"; "npx"; "vite" ] clientTestsPath - ] - |> runParallel) + do! ctx.RunCommand $"dotnet publish -c Release {serverPath} -o {deployPath}" + }) + } -Target.create "Format" (fun _ -> run dotnet [ "fantomas"; "." ] ".") + stage "Client" { + run "npm install" + run $"dotnet fable clean --cwd {clientPath} --yes" + run $"dotnet fable -o output -s --cwd {clientPath} --run npx vite build" + } + } -open Fake.Core.TargetOperators + runIfOnlySpecified // custom pipeline - dotnet run -- -p Bundle + } -let dependencies = [ - "Clean" ==> "InstallClient" ==> "Bundle" ==> "Azure" + pipeline "Azure" { + description "Deploy to Azure" - "Clean" ==> "InstallClient" ==> "Run" + stage "Farmer deploy" { + run (fun _ -> + let web = webApp { + name "SAFE-App" + operating_system Linux + runtime_stack (DotNet "8.0") + zip_deploy "deploy" + } - "InstallClient" ==> "RunTests" -] + let deployment = arm { + location Location.WestEurope + add_resource web + } -[] -let main args = runOrDefault args \ No newline at end of file + deployment |> Deploy.execute "SAFE-App" Deploy.NoParameters |> ignore) + } + + runIfOnlySpecified // custom pipeline - dotnet run -- -p Azure + } + + pipeline "Run" { + description "Runs the SAFE Stack application in watch mode" + + stage "Run" { + paralle + + stage "Server" { run $"dotnet watch run --project {serverPath}" } + + stage "Client" { + run "npm install" + run $"dotnet fable watch -o output -s --cwd {clientPath} --run npx vite" + } + } + + runIfOnlySpecified false // default pipeline - dotnet run + } + + tryPrintPipelineCommandHelp () + 0 \ No newline at end of file diff --git a/Content/default/Build.fsproj b/Content/default/Build.fsproj index f911d494..03ee918f 100644 --- a/Content/default/Build.fsproj +++ b/Content/default/Build.fsproj @@ -1,13 +1,12 @@ - - Exe - net8.0 - true - - - - - - + + Exe + net8.0 + true + + + + + \ No newline at end of file diff --git a/Content/default/Helpers.fs b/Content/default/Helpers.fs deleted file mode 100644 index afa0ddbe..00000000 --- a/Content/default/Helpers.fs +++ /dev/null @@ -1,105 +0,0 @@ -module Helpers - -open Fake.Core - -let initializeContext () = - let execContext = Context.FakeExecutionContext.Create false "build.fsx" [] - Context.setExecutionContext (Context.RuntimeContext.Fake execContext) - -module Proc = - module Parallel = - open System - - let locker = obj () - - let colors = [| - ConsoleColor.Blue - ConsoleColor.Yellow - ConsoleColor.Magenta - ConsoleColor.Cyan - ConsoleColor.DarkBlue - ConsoleColor.DarkYellow - ConsoleColor.DarkMagenta - ConsoleColor.DarkCyan - |] - - let print color (colored: string) (line: string) = - lock locker (fun () -> - let currentColor = Console.ForegroundColor - Console.ForegroundColor <- color - Console.Write colored - Console.ForegroundColor <- currentColor - Console.WriteLine line) - - let onStdout index name (line: string) = - let color = colors.[index % colors.Length] - - if isNull line then - print color $"{name}: --- END ---" "" - else if String.isNotNullOrEmpty line then - print color $"{name}: " line - - let onStderr name (line: string) = - let color = ConsoleColor.Red - - if isNull line |> not then - print color $"{name}: " line - - let redirect (index, (name, createProcess)) = - createProcess - |> CreateProcess.redirectOutputIfNotRedirected - |> CreateProcess.withOutputEvents (onStdout index name) (onStderr name) - - let printStarting indexed = - for (index, (name, c: CreateProcess<_>)) in indexed do - let color = colors.[index % colors.Length] - let wd = c.WorkingDirectory |> Option.defaultValue "" - let exe = c.Command.Executable - let args = c.Command.Arguments.ToStartInfo - print color $"{name}: {wd}> {exe} {args}" "" - - let run cs = - cs - |> Seq.toArray - |> Array.indexed - |> fun x -> - printStarting x - x - |> Array.map redirect - |> Array.Parallel.map Proc.run - -let createProcess exe args dir = - // Use `fromRawCommand` rather than `fromRawCommandLine`, as its behaviour is less likely to be misunderstood. - // See https://github.com/SAFE-Stack/SAFE-template/issues/551. - CreateProcess.fromRawCommand exe args - |> CreateProcess.withWorkingDirectory dir - |> CreateProcess.ensureExitCode - -let dotnet args dir = createProcess "dotnet" args dir - -let npm args dir = - let npmPath = - match ProcessUtils.tryFindFileOnPath "npm" with - | Some path -> path - | None -> - "npm was not found in path. Please install it and make sure it's available from your path. " - + "See https://safe-stack.github.io/docs/quickstart/#install-pre-requisites for more info" - |> failwith - - createProcess npmPath args dir - -let run proc arg dir = proc arg dir |> Proc.run |> ignore - -let runParallel processes = - processes |> Proc.Parallel.run |> ignore - -let runOrDefault args = - try - match args with - | [| target |] -> Target.runOrDefault target - | _ -> Target.runOrDefault "Run" - - 0 - with e -> - printfn "%A" e - 1 \ No newline at end of file diff --git a/Content/default/paket.dependencies b/Content/default/paket.dependencies index 302c3da0..f48beb23 100644 --- a/Content/default/paket.dependencies +++ b/Content/default/paket.dependencies @@ -16,6 +16,5 @@ nuget Fable.Mocha ~> 2 nuget Fable.Remoting.Client ~> 7 nuget Feliz ~> 2 -nuget Fake.Core.Target ~> 5 -nuget Fake.IO.FileSystem ~> 5 +nuget Fun.Build ~> 1 nuget Farmer ~> 1 \ No newline at end of file diff --git a/Content/default/paket.lock b/Content/default/paket.lock index cb541a76..820692eb 100644 --- a/Content/default/paket.lock +++ b/Content/default/paket.lock @@ -85,43 +85,6 @@ NUGET Fable.Core (>= 3.1.5) Fable.Parsimmon (>= 4.0) FSharp.Core (>= 4.7) - Fake.Core.CommandLineParsing (6.0) - FParsec (>= 1.1.1) - FSharp.Core (>= 6.0.3) - Fake.Core.Context (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Environment (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.FakeVar (6.0) - Fake.Core.Context (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Process (5.23.1) - Fake.Core.Environment (>= 5.23.1) - Fake.Core.FakeVar (>= 5.23.1) - Fake.Core.String (>= 5.23.1) - Fake.Core.Trace (>= 5.23.1) - Fake.IO.FileSystem (>= 5.23.1) - FSharp.Core (>= 6.0) - System.Collections.Immutable (>= 5.0) - Fake.Core.String (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Target (5.23.1) - Fake.Core.CommandLineParsing (>= 5.23.1) - Fake.Core.Context (>= 5.23.1) - Fake.Core.Environment (>= 5.23.1) - Fake.Core.FakeVar (>= 5.23.1) - Fake.Core.Process (>= 5.23.1) - Fake.Core.String (>= 5.23.1) - Fake.Core.Trace (>= 5.23.1) - FSharp.Control.Reactive (>= 5.0.2) - FSharp.Core (>= 6.0) - Fake.Core.Trace (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.FakeVar (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.IO.FileSystem (5.23.1) - Fake.Core.String (>= 5.23.1) - FSharp.Core (>= 6.0) Farmer (1.8) FSharp.Core (>= 5.0) System.Text.Json (>= 5.0) @@ -132,15 +95,16 @@ NUGET Feliz.CompilerPlugins (2.2) Fable.AST (>= 4.2.1) FSharp.Core (>= 4.7.2) - FParsec (1.1.1) - FSharp.Core (>= 4.3.4) - FSharp.Control.Reactive (5.0.5) - FSharp.Core (>= 4.7.2) - System.Reactive (>= 5.0 < 6.0) FSharp.Control.Websockets (0.2.3) FSharp.Core (>= 6.0) Microsoft.IO.RecyclableMemoryStream (>= 2.2.1) FSharp.Core (8.0.100) + Fun.Build (1.0.5) + FSharp.Core (>= 6.0) + Fun.Result (>= 2.0.9) + Spectre.Console (>= 0.46) + Fun.Result (2.0.9) + FSharp.Core (>= 6.0) Giraffe (6.2) FSharp.Core (>= 6.0) Giraffe.ViewEngine (>= 1.4) @@ -171,11 +135,12 @@ NUGET FSharp.Control.Websockets (>= 0.2.2) Giraffe (>= 6.0) Microsoft.AspNetCore.Authentication.JwtBearer (>= 6.0.3) - System.Collections.Immutable (8.0) + Spectre.Console (0.48) + System.Memory (>= 4.5.5) System.IdentityModel.Tokens.Jwt (7.0.3) Microsoft.IdentityModel.JsonWebTokens (>= 7.0.3) Microsoft.IdentityModel.Tokens (>= 7.0.3) - System.Reactive (5.0) + System.Memory (4.5.5) System.Text.Encodings.Web (8.0) System.Text.Json (8.0) System.Text.Encodings.Web (>= 8.0) diff --git a/Content/default/paket.references b/Content/default/paket.references index 64dba4d3..812591d9 100644 --- a/Content/default/paket.references +++ b/Content/default/paket.references @@ -1,3 +1,2 @@ -Fake.Core.Target -Fake.IO.FileSystem Farmer +Fun.Build \ No newline at end of file diff --git a/tests/Tests.fs b/tests/Tests.fs index c4959040..81d7a705 100644 --- a/tests/Tests.fs +++ b/tests/Tests.fs @@ -29,19 +29,22 @@ let npm = | true -> "./packages/Npm.js/tools/npm.cmd" | _ -> "/usr/bin/npm" -let execParams exe arg dir : ExecParams = - { Program = exe - WorkingDir = dir - CommandLine = arg - Args = [] } +let execParams exe arg dir : ExecParams = { + Program = exe + WorkingDir = dir + CommandLine = arg + Args = [] +} let logger = Log.create "SAFE" + let run exe arg dir = - logger.info( + logger.info ( eventX "Running `{exe} {arg}` in `{dir}`" >> setField "exe" exe >> setField "arg" arg - >> setField "dir" dir) + >> setField "dir" dir + ) CreateProcess.fromRawCommandLine exe arg |> CreateProcess.withWorkingDirectory dir @@ -53,76 +56,87 @@ let run exe arg dir = open System.Threading.Tasks let start exe arg dir = - logger.info( + logger.info ( eventX "Starting `{exe} {arg}` in `{dir}`" >> setField "exe" exe >> setField "arg" arg - >> setField "dir" dir) + >> setField "dir" dir + ) let psi = - { ProcStartInfo.Create() with - FileName = exe - Arguments = arg - WorkingDirectory = dir - RedirectStandardOutput = true - RedirectStandardInput = true - UseShellExecute = false }.AsStartInfo + { + ProcStartInfo.Create() with + FileName = exe + Arguments = arg + WorkingDirectory = dir + RedirectStandardOutput = true + RedirectStandardInput = true + UseShellExecute = false + } + .AsStartInfo Process.Start psi let asyncWithTimeout (timeout: TimeSpan) action = - async { - let! child = Async.StartChild( action, int timeout.TotalMilliseconds ) - return! child - } + async { + let! child = Async.StartChild(action, int timeout.TotalMilliseconds) + return! child + } -let waitForStdOut (proc : Process) (stdOutPhrase : string) timeout = +let waitForStdOut (proc: Process) (stdOutPhrase: string) timeout = async { let mutable line = "" + while line <> null && line.Contains stdOutPhrase |> not do try let! l = proc.StandardOutput.ReadLineAsync() |> Async.AwaitTask |> asyncWithTimeout (TimeSpan.FromSeconds 30.) + line <- l with :? TimeoutException -> failwith "Timeout occurred while waiting for line" - } |> asyncWithTimeout timeout + } + |> asyncWithTimeout timeout let waitAndRetry seconds times (func: unit -> 'result) = Policy .Handle() - .WaitAndRetry( - retryCount = times, - sleepDurationProvider = (fun _ _ -> TimeSpan.FromSeconds seconds)) + .WaitAndRetry(retryCount = times, sleepDurationProvider = (fun _ _ -> TimeSpan.FromSeconds seconds)) .Execute(func) let get (url: string) = - use client = new HttpClient () + use client = new HttpClient() client.GetStringAsync url |> Async.AwaitTask |> Async.RunSynchronously let childrenPids pid = let pgrep = if Environment.isWindows then - CreateProcess.fromRawCommand "wmic" ["process"; "where"; sprintf "(ParentProcessId=%i)" pid; "get"; "ProcessId" ] + CreateProcess.fromRawCommand "wmic" [ + "process" + "where" + sprintf "(ParentProcessId=%i)" pid + "get" + "ProcessId" + ] else - CreateProcess.fromRawCommand "pgrep" ["-P"; string pid] + CreateProcess.fromRawCommand "pgrep" [ "-P"; string pid ] |> CreateProcess.redirectOutput |> Proc.run - pgrep.Result.Output.Split ([|'\n'|]) - |> Array.choose - (fun x -> - match System.Int32.TryParse x with - | true, y -> Some y - | _ -> None) + pgrep.Result.Output.Split([| '\n' |]) + |> Array.choose (fun x -> + match System.Int32.TryParse x with + | true, y -> Some y + | _ -> None) let killProcessTree (pid: int) = - let rec getProcessTree (pid: int) = - [ for childPid in childrenPids pid do + let rec getProcessTree (pid: int) = [ + for childPid in childrenPids pid do yield! getProcessTree childPid - pid ] + pid + ] for pid in getProcessTree pid do let proc = @@ -130,90 +144,100 @@ let killProcessTree (pid: int) = Process.GetProcessById pid |> Some // The process specified by the processId parameter is not running. The identifier might be expired. with :? ArgumentException -> - logger.warn( - eventX "Can't kill process {pid}: process is not running" - >> setField "pid" pid) + logger.warn (eventX "Can't kill process {pid}: process is not running" >> setField "pid" pid) None match proc with | Some proc when not proc.HasExited -> - logger.info( - eventX "Killing process {pid}" - >> setField "pid" pid) + logger.info (eventX "Killing process {pid}" >> setField "pid" pid) + try - proc.Kill () + proc.Kill() with e -> - logger.warn( + logger.warn ( eventX "Failed to kill process {pid}: {msg}" >> setField "pid" pid - >> setField "msg" e.Message) - | _ -> - () + >> setField "msg" e.Message + ) + | _ -> () -type TemplateType = Normal | Minimal +type TemplateType = + | Normal + | Minimal let path = __SOURCE_DIRECTORY__ ".." "Content" -let testTemplateBuild templateType = testCase $"{templateType}" <| fun () -> - let dir = if templateType = Normal then path "default" else path "minimal" - - run dotnet "tool restore" dir +let testTemplateBuild templateType = + testCase $"{templateType}" + <| fun () -> + let dir = + if templateType = Normal then + path "default" + else + path "minimal" - if templateType = Minimal then - // run build on Shared to avoid race condition between Client and Server - run dotnet "build" (dir "src" "Shared") + run dotnet "tool restore" dir - if templateType = Normal then - run dotnet "run" (dir "tests" "Server") + if templateType = Minimal then + // run build on Shared to avoid race condition between Client and Server + run dotnet "build" (dir "src" "Shared") - let proc = if templateType = Normal then - start dotnet "run" dir - else - run npm "install" dir - start dotnet "fable watch --run vite" (dir "src" "Client" ) - - let extraProc = - if templateType = Normal then None - else - let proc = start dotnet "run" (dir "src" "Server") - let wait = waitForStdOut proc "Now listening on:" - Some (proc, wait) - - let stdOutPhrase = "ready in" - let htmlSearchPhrase = """SAFE Template""" - //vite will not serve up from root - let clientUrl = "http://localhost:8080/index.html" - let serverUrl, searchPhrase = - match templateType with - | Normal -> "http://localhost:5000/api/ITodosApi/getTodos", "Create new SAFE project" // JSON should contain a todo with such description - | Minimal -> "http://localhost:5000/api/hello", "Hello from SAFE!" - try - let timeout = TimeSpan.FromMinutes 5. - waitForStdOut proc stdOutPhrase timeout |> Async.RunSynchronously - logger.info( - eventX "Requesting `{url}`" - >> setField "url" clientUrl) - let response = waitAndRetry 3 5 (fun () -> get clientUrl) - Expect.stringContains response htmlSearchPhrase - (sprintf "html fragment not found for %A" templateType) - extraProc |> Option.iter (fun (_, wait) -> Async.RunSynchronously (wait timeout)) - logger.info( - eventX "Requesting `{url}`" - >> setField "url" serverUrl) - let response = get serverUrl - Expect.stringContains response searchPhrase - (sprintf "plaintext fragment not found for %A at %s" templateType serverUrl) - logger.info( - eventX "Run target for `{type}` run successfully" - >> setField "type" templateType) - if templateType = Normal then - run dotnet "run -- bundle" dir - logger.info( - eventX "Bundle target for `{type}` run successfully" - >> setField "type" templateType) - finally - killProcessTree proc.Id - extraProc |> Option.map (fun (p,_) -> p.Id) |> Option.iter killProcessTree + run dotnet "run" (dir "tests" "Server") + let proc = + if templateType = Normal then + start dotnet "run" dir + else + run npm "install" dir + start dotnet "fable watch --run vite" (dir "src" "Client") + + let extraProc = + if templateType = Normal then + None + else + let proc = start dotnet "run" (dir "src" "Server") + let wait = waitForStdOut proc "Now listening on:" + Some(proc, wait) + + let stdOutPhrase = "ready in" + let htmlSearchPhrase = """SAFE Template""" + //vite will not serve up from root + let clientUrl = "http://localhost:8080/index.html" + + let serverUrl, searchPhrase = + match templateType with + | Normal -> "http://localhost:5000/api/ITodosApi/getTodos", "Create new SAFE project" // JSON should contain a todo with such description + | Minimal -> "http://localhost:5000/api/hello", "Hello from SAFE!" + + try + let timeout = TimeSpan.FromMinutes 5. + waitForStdOut proc stdOutPhrase timeout |> Async.RunSynchronously + logger.info (eventX "Requesting `{url}`" >> setField "url" clientUrl) + let response = waitAndRetry 3 5 (fun () -> get clientUrl) + Expect.stringContains response htmlSearchPhrase (sprintf "html fragment not found for %A" templateType) + extraProc |> Option.iter (fun (_, wait) -> Async.RunSynchronously(wait timeout)) + logger.info (eventX "Requesting `{url}`" >> setField "url" serverUrl) + let response = get serverUrl + + Expect.stringContains + response + searchPhrase + (sprintf "plaintext fragment not found for %A at %s" templateType serverUrl) + + logger.info ( + eventX "Run target for `{type}` run successfully" + >> setField "type" templateType + ) + + if templateType = Normal then + run dotnet "run -- -p Bundle" dir + + logger.info ( + eventX "Bundle target for `{type}` run successfully" + >> setField "type" templateType + ) + finally + killProcessTree proc.Id + extraProc |> Option.map (fun (p, _) -> p.Id) |> Option.iter killProcessTree