diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml new file mode 100644 index 0000000..0c611db --- /dev/null +++ b/.github/workflows/build.yml @@ -0,0 +1,24 @@ +# This workflow will build a .NET project +# For more information see: https://docs.github.com/en/actions/automating-builds-and-tests/building-and-testing-net + +name: Build and test + +on: + push: + branches: [ "dev" ] + pull_request: + branches: [ "dev" ] + +jobs: + build: + if: github.event_name != 'push' || !startsWith(github.ref, 'refs/tags/v') + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v3 + - name: Setup .NET + uses: actions/setup-dotnet@v3 + with: + dotnet-version: 9.0.x + - name: Build & test + run: dotnet fsi build.fsx -- -- build test \ No newline at end of file diff --git a/.github/workflows/publish.yml b/.github/workflows/publish.yml new file mode 100644 index 0000000..086b8f2 --- /dev/null +++ b/.github/workflows/publish.yml @@ -0,0 +1,43 @@ +# This workflow will build a .NET project +# For more information see: https://docs.github.com/en/actions/automating-builds-and-tests/building-and-testing-net + +name: Publish package + +on: + push: + tags: + - 'v*' + +jobs: + publish: + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v3 + - name: Setup .NET + uses: actions/setup-dotnet@v3 + with: + dotnet-version: 9.0.x + + - name: Extract version from tag + id: version + run: | + TAG_NAME="${{ github.ref_name }}" + VERSION="${TAG_NAME#v}" # Remove 'v' prefix + echo "version=${VERSION}.${{ github.run_number }}" >> $GITHUB_OUTPUT + + - name: Build and test + run: dotnet fsi build.fsx -- -- build test pack + env: + VERSION: ${{ steps.version.outputs.version }} + + - name: Publish + run: dotnet nuget push out/*.nupkg --api-key ${{ secrets.NUGET_API_KEY }} --source https://www.nuget.org/api/v2/package + + - name: Upload build log + uses: actions/upload-artifact@v4 + if: always() + with: + name: build-log-${{ github.run_number }}.txt + path: build.log + retention-days: 5 diff --git a/.gitignore b/.gitignore index 8bbb6ff..3c80fb2 100644 --- a/.gitignore +++ b/.gitignore @@ -14,6 +14,7 @@ _UpgradeReport* packages .nuget .paket +.ionide # Ignore Visual Studio files *.pdb @@ -32,11 +33,14 @@ TestResult.* .xake* .fake .vs/ +.vscode/ +.ionide/ samples/**/*.exe samples/**/*.dll samples/**/*.fsx.lock .idea temp +.claude/settings.local.json ~testout~ paket-files/ /out diff --git a/.travis.yml b/.travis.yml index d534405..32fcc2e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,16 +1,12 @@ language: csharp -mono: latest -dotnet: 2.1.300 +dotnet: 7.0.202 env: VER=$(if [[ "${TRAVIS_TAG:0:1}" == "v" ]]; then echo ${TRAVIS_TAG:1}.${TRAVIS_BUILD_NUMBER}; else echo 1.0.0.${TRAVIS_BUILD_NUMBER}; fi;) -install: - - dotnet restore build.proj script: - - export FrameworkPathOverride=$(dirname $(which mono))/../lib/mono/4.5-api/ - - dotnet fake run build.fsx -- build test -ll Diag + - dotnet fsi build.fsx -- -- build test -ll Diag deploy: - provider: script - script: dotnet fake run build.fsx -- pack push -ll Diag + script: dotnet fsi build.fsx -- -- pack push -ll Diag skip_cleanup: true on: tags: true - condition: "${TRAVIS_TAG:0:1} = v" + condition: "${TRAVIS_TAG:0:1} = v" \ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index e2dfd84..0000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,5 +0,0 @@ -// Place your settings in this file to overwrite default and user settings. -{ - "editor.wordWrap": "wordWrapColumn", - "editor.wordWrapColumn": 120 -} \ No newline at end of file diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..35230eb --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,83 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## Project Overview + +Xake is an F# build utility inspired by Shake. It uses F# as a full programming language to define build rules with dependency tracking, incremental builds, and parallel execution. Xake is self-hosting — it builds itself using its own build script (`build.fsx`). + +## Build & Test Commands + +```bash +# Build and test (primary command) +dotnet fsi build.fsx -- -- build test + +# Build core library only +dotnet build src/core + +# Run all tests +dotnet test src/tests + +# Run tests matching a filter +dotnet test src/tests --filter "Name~\"some pattern\"" + +# Build + filtered test via build script +dotnet fsi build.fsx -- -- build test -d FILTER=TestName + +# Clean +dotnet fsi build.fsx -- -- clean +``` + +Requires .NET SDK 9.0+ (see `global.json`). + +## Architecture + +### Core Concepts + +- **Target**: What a rule produces — either a `FileTarget` (file path) or `PhonyAction` (named action) +- **Rule**: Maps a target pattern to a Recipe. Types: `FileRule`, `MultiFileRule`, `PhonyRule`, `FileConditionRule` +- **Recipe**: Async-like computation expression (`recipe { ... }`) that builds a target and tracks dependencies +- **Dependency**: Tracked inputs — `FileDep`, `ArtifactDep`, `EnvVar`, `Var`, `AlwaysRerun`, `GetFiles` + +### Execution Flow + +``` +Program.fs (CLI parsing) → ExecCore.runScript() → DependencyAnalysis → +WorkerPool (parallel execution) → Rule matching & Recipe execution → Database.fs (persist state) +``` + +### Key Source Files + +| File | Role | +|------|------| +| `src/core/ExecCore.fs` | Main execution engine: rule matching, recipe execution, dependency tracking | +| `src/core/Database.fs` | Build state persistence for incremental builds | +| `src/core/ExecTypes.fs` | Configuration types (`ExecOptions`) and execution context | +| `src/core/DependencyAnalysis.fs` | Topological sorting and execution order | +| `src/core/WorkerPool.fs` | Thread pool for parallel rule execution | +| `src/core/Program.fs` | CLI argument parsing | +| `src/core/XakeScript.fs` | `xakeScript` computation expression builder | +| `src/core/RecipeBuilder.fs` | `recipe` computation expression builder | +| `src/core/Fileset.fs` | Ant-style file pattern matching with named capture groups | +| `src/core/Types.fs` | Domain types (Target, Rule, Recipe, Dependency, BuildResult) | + +### Project Layout + +- `src/core/` — Core library (`Xake.fsproj`), targets net462 + netstandard2.0 +- `src/tests/` — NUnit tests, targets net9.0 +- `build.fsx` — Self-hosting build script +- `docs/` — Documentation (overview, implementation notes, dev process) +- `samples/` — Example Xake scripts +- `.xake` — Binary build database file (do not commit) + +## F# Patterns Used + +- **Computation expressions** for both build scripts (`xakeScript { ... }`) and build actions (`recipe { ... }`) +- **Discriminated unions** extensively for Target, Rule, Dependency types +- **Pattern matching** on file paths with Ant-style globs and named capture groups (e.g., `"(dir:*)/file.(ext:*)"`) +- OS-aware path comparison (case-insensitive on Windows, ordinal on Unix) + +## Development Workflow + +- Feature branches merge to `dev` via PR with squash +- Releases: merge `dev` to `master`, tag with `v` prefix (triggers NuGet publish via GitHub Actions) diff --git a/LICENSE b/LICENSE index b46cf05..07818d6 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2014 OlegZee +Copyright (c) 2014-2024 OlegZee Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/build.cmd b/build.cmd index 3986414..4d1719c 100644 --- a/build.cmd +++ b/build.cmd @@ -1,3 +1,2 @@ @echo off -dotnet restore build.proj -dotnet fake run build.fsx -- build \ No newline at end of file +dotnet fsi build.fsx -- -- build \ No newline at end of file diff --git a/build.fsx b/build.fsx index 0e27744..e12721c 100644 --- a/build.fsx +++ b/build.fsx @@ -1,129 +1,96 @@ -#r "paket: - nuget Xake ~> 1.1 prerelease //" - -#if !FAKE -#load ".fake/build.fsx/intellisense.fsx" -#endif +#r "nuget: Xake, 3.0.0" +// #r "out/netstandard2.0/Xake.dll" open Xake open Xake.Tasks -let frameworks = ["netstandard2.0"; "net46"] +let vars = {| + Version = Var.create(description = "Version number for the package, e.g. 1.2.3") |> withDefault "0.0.1" + NUGET_KEY = Var.env(description = "API key for NuGet.org, required for pushing packages") |> withDefault "" + TestFilter = Var.string(envVar = "FILTER", description = "Optional filter clause for test selection, e.g. 'MyNamespace.*Tests'") +|} + +let frameworks = ["netstandard2.0" (*; "net46" *)] let libtargets = - [ for t in frameworks do - for e in ["dll"; "xml"] - -> sprintf "out/%s/Xake.%s" t e + [ for fwk in frameworks do + for ext in ["dll"; "xml"] + -> $"out/%s{fwk}/Xake.%s{ext}" ] -let getVersion () = recipe { - let! verVar = getVar("VER") - let! verEnv = getEnv("VER") - let ver = verVar |> Option.defaultValue (verEnv |> Option.defaultValue "0.0.1") - - let! verSuffix = - getVar("SUFFIX") - |> Recipe.map ( - function - | None -> "-beta" - | Some "" -> "" // this is release! - | Some s -> "-" + s - ) - return ver + verSuffix -} +let makePackageName version = $"Xake.%s{version}.nupkg" -let makePackageName = sprintf "Xake.%s.nupkg" - -let dotnet arglist = recipe { - do! shell { - cmd "dotnet" - args arglist - failonerror - } |> Recipe.Ignore -} +let dotnet arglist = sh "dotnet" { args arglist; failonerror } do xakeScript { - filelog "build.log" Verbosity.Diag - // consolelog Verbosity.Normal + filelog "build.log" Diag + varschema vars rules [ - "main" => recipe { - do! need ["build"] - do! need ["test"] - } + "main" <<< ["build"; "test"] "build" <== libtargets "clean" => rm {dir "out"} - "test" => recipe { - do! alwaysRerun() - - let! where = - getVar("FILTER") - |> Recipe.map (function |Some clause -> ["--filter"; sprintf "Name~\"%s\"" clause] | None -> []) + command "test" { + let! testFilter = vars.TestFilter + let where = [ for f in Option.toList testFilter do yield $"--filter Name~\"{f}\"" ] - // in case of travis only run tests for standard runtime, eventually will add more - let! limitFwk = getEnv("TRAVIS") |> Recipe.map (function | Some _ -> ["-f:netcoreapp2.0"] | _ -> []) - - do! dotnet <| ["test"; "src/tests"; "-c"; "Release"] @ where @ limitFwk + do! sh "dotnet test src/tests -c Release" { args where; failonerror } } - libtargets *..> recipe { + targets libtargets { - let! allFiles - = getFiles <| fileset { - basedir "src/core" - includes "Xake.fsproj" - includes "**/*.fs" - } + let! allFiles = getFiles <| fileset { + basedir "src/core" + includes "Xake.fsproj" + includes "**/*.fs" + } do! needFiles allFiles - let! version = getVersion() + let! version = vars.Version for framework in frameworks do - do! dotnet - [ - "build" - "src/core" - "/p:Version=" + version - "--configuration"; "Release" - "--framework"; framework - "--output"; "../../out/" + framework - "/p:DocumentationFile=Xake.xml" - ] + do! dotnet [ + "build" + "src/core" + "/p:Version=" + version + "--configuration"; "Release" + "--framework"; framework + "--output"; "./out/" + framework + "/p:DocumentationFile=Xake.xml" + ] } ] (* Nuget publishing rules *) rules [ - "pack" => recipe { - let! version = getVersion() + command "pack" { + let! version = vars.Version do! need ["out" makePackageName version] } - "out/Xake.(ver:*).nupkg" ..> recipe { - let! ver = getRuleMatch("ver") - do! dotnet - [ - "pack"; "src/core" - "-c"; "Release" - "/p:Version=" + ver - "--output"; "../../out/" - "/p:DocumentationFile=Xake.xml" - ] + target "out/Xake.(ver:*).nupkg" { + let! ver = getRuleMatch "ver" + do! dotnet [ + "pack"; "src/core" + "-c"; "Release" + $"/p:Version={ver}" + "--output"; "out/" + "/p:DocumentationFile=Xake.xml" + ] } // push need pack to be explicitly called in advance - "push" => recipe { - let! version = getVersion() - - let! nuget_key = getEnv("NUGET_KEY") - do! dotnet - [ - "nuget"; "push" - "out" makePackageName version - "--source"; "https://www.nuget.org/api/v2/package" - "--api-key"; nuget_key |> Option.defaultValue "" - ] + command "push" { + let! version = vars.Version + let! nuget_key = vars.NUGET_KEY + + do! dotnet [ + "nuget"; "push" + "out" makePackageName version + "--source"; "https://www.nuget.org/api/v2/package" + "--api-key"; nuget_key + ] } ] } diff --git a/build.fsx.lock b/build.fsx.lock deleted file mode 100644 index 5497458..0000000 --- a/build.fsx.lock +++ /dev/null @@ -1,7 +0,0 @@ -STORAGE: NONE -RESTRICTION: == netstandard2.0 -NUGET - remote: https://api.nuget.org/v3/index.json - FSharp.Core (4.3.4) - Xake (1.1.0.413-alpha) - FSharp.Core (>= 4.3.4) diff --git a/build.proj b/build.proj deleted file mode 100644 index 5483b72..0000000 --- a/build.proj +++ /dev/null @@ -1,10 +0,0 @@ - - - - netstandard2.0 - - - - - - diff --git a/build.sh b/build.sh index f19bb05..359a510 100755 --- a/build.sh +++ b/build.sh @@ -1,3 +1,2 @@ #!/bin/bash -dotnet restore build.proj -dotnet fake run build.fsx -- build \ No newline at end of file +dotnet fsi build.fsx -- -- \ No newline at end of file diff --git a/docs/cheatsheet.md b/docs/cheatsheet.md new file mode 100644 index 0000000..2f95877 --- /dev/null +++ b/docs/cheatsheet.md @@ -0,0 +1,111 @@ +# Xake cheatsheet + +## Package reference + +```fsharp +#r "nuget: Xake, 3.0.0" +open Xake +open Xake.Tasks +``` + +## Script entry point + +```fsharp +do xakeScript { + rules [ + "main" <== ["build"; "test"] + ] +} +``` + +## Dependency operators + +`<==` demand targets in parallel: + +```fsharp +"main" <== ["build"; "test"] +``` + +`<<<` demand targets in sequence: + +```fsharp +"deploy" <<< ["build"; "test"; "package"] +``` + +`=>` plain phony rule: + +```fsharp +"clean" => rm {dir "out"} +``` + +## Preferred rule forms + +```fsharp +rules [ + command "build" { + do! sh "dotnet build src/core -c Release" {} + } + + target "out/version.txt" { + do! writeText "1.0.0" + } + + targets ["out/a.dll"; "out/a.xml"] { + do! sh "dotnet build src/core -c Release -o out" {} + } +] +``` + +## Recipe helpers + +```fsharp +recipe { + do! need ["out/a.dll"] + let! files = getFiles <| fileset { includes "src/**/*.fs" } + do! needFiles files + do! trace Info "Done" +} +``` + +## Shell task + +```fsharp +do! sh "dotnet" { + args ["test"; "src/tests"; "-c"; "Release"] + failonerror +} +``` + +## Filesets + +```fsharp +let src = !! "src/**/*.fs" +let srcInCore = !! "**/*.fs" @@ "src/core" +``` + +## CLI invocation + +Default target: + +```bash +dotnet fsi build.fsx +``` + +Options and targets: + +```bash +dotnet fsi build.fsx -- -- clean build test +``` + +Variable: + +```bash +dotnet fsi build.fsx -- -- build -d Version=1.2.3 +``` + +Dry run: + +```bash +dotnet fsi build.fsx -- -- build --dryrun +``` + diff --git a/docs/devprocess.md b/docs/devprocess.md index cc7242d..0edda22 100644 --- a/docs/devprocess.md +++ b/docs/devprocess.md @@ -1,67 +1,105 @@ -# Develop/release routines +# Development process -Describes some routines, mostly notes for myself. +This document describes the practical workflow for developing and releasing Xake. -## Developing a new feature (repo owner) +## Requirements -* create feature branch (local) -* push to server -* create PR to Xake/dev branch -* wait for checks, in case of failure push fixes to the same branch -* merge with squash to dev +- .NET SDK 9.0 or newer +- GitHub access to the repository -## Contributing new feature +## Branch workflow -* clone repo -* create feature branch from origin/dev head) -* push branch to server -* create PR to Xake/dev branch -* wait for checks, in case of failure push fixes to the same branch +Repository owner flow: -## Release +1. Create a feature branch from `dev` +2. Push branch +3. Open a pull request to `dev` +4. Wait for checks +5. Push fixes if checks fail +6. Merge with squash -* merge dev to master -* tag the version with `v` prefix +External contribution flow: -```cmd -git checkout master -git tag -v v1.0 -git push --tags -``` +1. Fork or clone repository +2. Create a feature branch from `origin/dev` +3. Push branch +4. Open a pull request to `dev` +5. Address review comments and failed checks -## Tests +## Build and test -Running tests on netstandard target: +Primary command: +```bash +dotnet fsi build.fsx -- -- build test ``` -dotnet test -f:netcoreapp2.0 + +Build core only: + +```bash +dotnet build src/core -c Release ``` -Example of selective test run: +Run all tests: +```bash +dotnet test src/tests -c Release ``` -dotnet test -f:net46 --filter Name~"Rm deletes" -dotnet fake run build.fsx -- test -d FILTER=Rm + +Run filtered tests: + +```bash +dotnet test src/tests -c Release --filter "Name~Rm" +``` + +Run filtered tests through Xake variable: + +```bash +dotnet fsi build.fsx -- -- test -d FILTER=Rm ``` -## Publishing +## Command line style -The commands below assume you've defined `NUGET_KEY` in environment variables. +Use this format for Xake scripts: +```bash +dotnet fsi build.fsx -- -- [options] [targets] ``` -dotnet fake run build.fsx -- pack -d VER=1.2.3 -dotnet fake run build.fsx -- push -d VER=1.2.3 + +Examples: + +```bash +dotnet fsi build.fsx +dotnet fsi build.fsx -- -- clean build test +dotnet fsi build.fsx -- -- build;test +dotnet fsi build.fsx -- -- build --dryrun ``` -> Define `SUFFIX` variable set to empty for final releases. Otherwise it defaults to `-alpha` +## Packaging and publishing + +Set `NUGET_KEY` in environment. -### Not using build.fsx +Create package: + +```bash +dotnet fsi build.fsx -- -- pack -d Version=3.0.0 +``` -Here're the commands issues by a build script. -> Do not use for publishing. This is just for reference. +Push package: +```bash +dotnet fsi build.fsx -- -- push -d Version=3.0.0 -d NUGET_KEY=$NUGET_KEY ``` -dotnet pack -c Release /p:Version=1.2.3-alpha4 -dotnet nuget push out\Xake.1.0.6.344-alpha.nupkg --source https://www.nuget.org/api/v2/package --api-key %NUGET_KEY% +## Release + +1. Merge `dev` into `master` +2. Tag release with `v` prefix +3. Push tag + +```bash +git checkout master +git pull +git tag v3.0.0 +git push --tags ``` \ No newline at end of file diff --git a/docs/implnotes.md b/docs/implnotes.md index 0d667cf..bc5049d 100644 --- a/docs/implnotes.md +++ b/docs/implnotes.md @@ -1,231 +1,79 @@ # Implementation notes -## Fileset +This file keeps high level technical notes about Xake internals. -Implementation is very similar to NAnt's one, it does support: +## Build model -* disk reference -* parent dir reference -* directories and directory masks -* recurse mask (e.f. "source/**/*.c"), supports -* file name and mask -* both "/" and "\" as a path separator +Xake scripts define rules for targets. During execution, the engine records dependencies and stores build state in `.xake`. -Fileset has two major subtypes - either **set of rules** or a **file list**, also called "materialized" fileset. +A target is rebuilt when at least one condition is true: -### Non-existing files +- output does not exist +- dependency files changed +- dependency target was rebuilt +- variable or environment dependency changed +- recipe requests rerun by `alwaysRerun` -Filesets are used to reference both existing files (e.g. project source files) and **targets** which might not exist when fileset is "materialized". In case the file or directory name is treated as a mask, the non-existing file will be omitted from resulting file list and the build will likely fail. -The rule to resolve such inconsistency the rule (part of pattern) without mask is added to resulting file list explicitly. +## Dependency storage -NOTE: it should depend on the context: if fileset defines source files or references "explicit rule" is ok. +The build database stores: -## Error handling and diagnostics +- target graph +- requested dependencies +- file list snapshots from filesets +- variable and environment reads -Error handling assumes the following system behavior: +This enables incremental rebuild and `--dryrun` estimation. -* system provide screen and file log for all targets built and other system actions -* allows to specify detail level for screen and file separately -* any uncaught exception in build rule leads to script failure unless FailOnError property is for particular target is set to False (consider "deploy" target with a fallback implementation) -* failures and stack traces are written to log -* idea: "onfail" target, "onfail" rule setting -* idea: dump the whole trace to the target -* setting error-code for the fsi sessions +## Rules and scheduling -### Implemented ideas +- `<==` demands dependencies in parallel +- `<<<` demands dependencies in sequence +- worker count defaults to CPU core count and can be overridden by `-t` -#### try/with/finally exception handling +Parallel execution still respects dependency order. -`recipe` computation expression supports try/with and try/finally blocks. +## Filesets -```fsharp -recipe { - do! log "before try" +Filesets support Ant style masks, recursive `**`, and named match groups in rule patterns. - try - try - do! log "Body executed" - failwith "Ouch" - with e -> - do! log "Exception: %s" e.Message - finally - printfn "Error!" -} -``` +Common behavior: -> actions (with do! notation) are allowed in `with` block but aren't in `finally` block. This is limitation of F#'s computation expressions. +- path separators `/` and `\\` are accepted +- file list result is tracked as dependency input +- change in resolved file list can trigger rebuild -#### WhenError function +## Recipe behavior -Intercepts errors (exceptions) and allows to define a custom handler. +`recipe` computation supports standard control flow and async style composition with `do!` and `let!`. -```fsharp - phony "main" (action { - do! trace Message "The exception thrown below will be silently ignored" - failwith "some error" - } |> WhenError ignore) -``` +Notes: -#### FailWhen +- `do!` works in `with` blocks +- `do!` does not work in `finally` blocks due to F# computation expression limits +- `WhenError`, `FailWhen`, and `CheckErrorLevel` are available for explicit error flow -Raises the exception if action's result meet specified condition. -E.g. the following code raises error in case errorlevel (result of shell command execution) gets non-zero value. +## Logging -```fsharp -do! _system [shellcmd] "dir" |> FailWhen ((<>) 0) "Failed to list files in folder" -// or just -do! _system [shellcmd] "dir" |> CheckErrorLevel -``` +Xake supports console and file logging with separate verbosity levels. -### Other ideas +Log levels: -// or even that: +- `Silent` +- `Quiet` +- `Normal` +- `Loud` +- `Chatty` +- `Diag` -```fsharp -_system [fail_on_error; shellcmd] "dir" -// where shellcmd and fail_on_error are functions -``` +## Runtime and platform -Idea #3 (orthogonal): provide an option for _system function to fail in case non-zero errorcode. +The current repository targets modern `dotnet` workflow with .NET SDK 9.0+. -```fsharp -do! _system [fail_on_error; shellcmd; startin "./bin"] "dir" -// where shellcmd and fail_on_error are functions -``` +Legacy Mono and .NET Framework details from older versions are intentionally excluded from this document. -### Ideas +## Teardown behavior -Implemented IgnoreErrors. +Teardown rules are defined in script and run during shutdown when engine mode calls `StopAsync`. -* ExecContext option to ignore all errors -* fail on system with non zero exit code -* fail always try/catch - -## Incremental build - -Xake attempts to reduce build time by analyzing results of last build. Build rule is executed if any of these conditions are met: - -* any of dependency source files are changed -* dependency artifact was rebuilt -* there no dependencies at all (e.g. "clean" task), otherwise with incremental builds it will never rebuild -* action is marked with alwaysRerun -* environment variable or script variable the script or any task requests is changed - -### Implementation: Analyze last run - -This option is found in "shake" project. It stores all targets and their dependencies in database. Whenever the target is requested it checks -whether it needs to be built by analyzing whether any dependencies are changed. -The benefits of this approach in comparison to option 1 are: - -* easier to implement due to more straightforward logic -* allows to analyze the whole dependencies graph before running any target -* ... and estimate the build time -* does not require changes in tasks implementation ("whenNeeded") - -The difference is that the decision is made early, before executing target while option 1 does execute the code and makes a decision upon request. - -### Random thoughts - -GetFiles will be new monadic function. Record the call in dependencies as GetFileList(), both rules and results. Track only different results. -Need is traced as before i.e. for every "need" we record the exec time and target name. - -## .NET Runtime -Xake allows using both Mono and .NET frameworks explicitly by defining `NETFX` variable. -Default behavior is to use the framework the script is running under. E.g. if running under Mono `fsharpi` recent mono toolset will be used. - -List of valid targets: - - | "net-20" | "net-2.0" | "2.0" - | "net-30" | "net-3.0" | "3.0" - | "net-35" | "net-3.5" | "3.5" - | "net-40c"| "net-4.0c" | "4.0-client" - | "net-40" | "net-4.0" | "4.0"| "4.0-full" - | "net-45" | "net-4.5" | "4.5"| "4.5-full" - - | "mono-20" | "mono-2.0" | "2.0" - | "mono-35" | "mono-3.5" | "3.5" - | "mono-40" | "mono-4.0" | "4.0" - | "mono-45" | "mono-4.5" | "4.5" - -Use "2.0".."4.5" targets for multi-platform environments (will target mono-XXX being run under mono framework). - -Tasks:* various supported options for csc - -## Variables - - * NETFX - framework version to use for compilation, resources. E.g. "2.0", "3.5", "4.0". Default: highest available on the computer. - - -### Do not allow to override options - -Command line arguments override the script options (XakeOptions type) unless you define options.IgnoreCommandLine = true. - -## Propose: named match groups in file or directory masks - -Allows to extract substring from a file or directory masks. Handy for defining -"parameterized" rules. According to product idea any artifact is unique and has its -own file so any parameterized rule is resolved to a file. - -E.g. `"bin\(type:*)\Application.exe"` defines a mask with a named part referencing directory. -The call to `match mask "bin\Debug\Application.exe"` will result in `MatchResult.Ok ["type", "Debug"]`. - -Named groups Mask is defined either for DirectoryMask of FileMask. -Nested groups are ok too, e.g. `"(filename:(arch:*)-(platform:*)-lld).(ext:*)"` matches the file -`x86-win-lld.app` and returns map {"filename", "x86-win-lld"; "arch", "x86"; "platform", "win"; "ext", "app"} - -```fsharp -var mask = "(arch:*)-(platform:*)-autoexec.(ext:*)"; -var mask2 = "(filename:(arch:*)-(platform:*)-lld).(ext:*)"; - -var mm = Regex.Match ("x86-win-autoexec.bat", @"(?(?.*)-(?.*)-autoexec)\.(?.*)"); -mm.Groups["arch"].Dump(); -mm.Groups["platform"].Dump(); -mm.Groups["ext"].Dump(); -mm.Groups["filename"].Dump(); -``` - -## Other - -* file names are cases sensitive now. In the future it's planned to be system-dependent -* external libraries has to be copied to target folder. How to accomplish? - * csc task option "copy deps to output folder" - * manually copy (need tracking which are really needed) - * explicit external map of deps: use both - -## File/Target and other types - -Made File a module with T type which details are hidden. API is exposed as functions within a File module and -also some widely used properties are available as File.T members. - -The reason for 'Name' property is a user-friendly output and I'm going to change it to a relative names. -Expected the following issues: - -* File functions operate on File.T type which is not usable in user scripts -> Resolution: script will not use this type, instead we will expose FileTasks and tell to use System.IO.File -* `Csc` and other tasks has an `Out` parameter which got `File.T` type. This is not going to be user friendly. And I should consider changing it to string. However in most cases this value is passed from action parameters so the types should be coherent - -The motivations are: - -* to be more statically typed internally. This is the reason for not using strings. -* FileInfo is a poorly collected garbage. I'd use both internally and externally more accurate abstraction -* FileInfo is unlikely Unix-friendly and allows comparison and such things -* provide more nice operators for end-user, let combine the paths, change extensions and so on -* more coupled integration with Path type (WHAT?) -* attempt to make abstract `Artifact` entity which would allow to define not only files but say in-memory data streams or byte arrays. In such terms phony actions could be regular rules producing no file. - -The decision points: - -* use File everywhere -* Expose the type but primarily for internal use -* reconsider out parameter (change to string) - check the pros and cons - -### Build notes - -Release new version by tagging the commit: - - git tag v0.3.6 - git push --tags - -#### Running particular test from command line - - fsi build.fsx -- test -d "WHERE=test==\"SystemTasksTests.shell\"" +In CLI script mode, teardown targets are carried through options and may require explicit demand depending on run mode. diff --git a/docs/overview.md b/docs/overview.md index 9abff59..35c90bb 100644 --- a/docs/overview.md +++ b/docs/overview.md @@ -1,417 +1,94 @@ - - -**Table of Contents** *generated with [DocToc](https://github.com/thlorenz/doctoc)* +## Xake overview - - [The first script](#the-first-script) - - [Bootstrapping Xake.Core](#bootstrapping-xakecore) - - [So what?](#so-what) - - [Dependencies tracking](#dependencies-tracking) - - [Running multiple rules in parallel](#running-multiple-rules-in-parallel) -- [Build script elements](#build-script-elements) - - [Script header](#script-header) - - ["Main" function](#main-function) - - [rule](#rule) - - [file patterns, named groups](#file-patterns-named-groups) - - [phony](#phony) - - [rules](#rules) - - [want](#want) - - [wantOverride](#wantoverride) - - [action computation](#action-computation) - - [Tasks, `do!` notation](#tasks-do-notation) - - [Exception handling](#exception-handling) - - [need](#need) - - [Filesets](#filesets) - - [Other functions](#other-functions) - - [Script variables](#script-variables) - - [Env module](#env-module) - - [Tasks](#tasks) - - [File tasks](#file-tasks) - - [Dotnet tasks](#dotnet-tasks) +Xake is a build automation tool for .NET that uses F# scripts. +It tracks dependencies, supports incremental builds, and runs independent targets in parallel. - +Current project baseline: -Xake script is just an F# script with some flavors. +- .NET SDK 9.0 or newer +- Xake NuGet package `3.0.0` -## The first script - -The most simple, but structured script looks as follows: +## Minimal script ```fsharp -#r @".tools/Xake.Core.dll" // (1) - -open Xake // (2) - -do xakeScript { // (3) - - "main" <== ["hw.exe"] // (4) - - rule("hw.exe" *> // (5) - Csc { - CscSettings with - Src = !! "a*.cs" - }) -} -``` - -Here are we doing the following steps: - -1. reference f# library containing core testing functionality -1. open Xake namespace, so that we can use some Xake types -1. define a "main" function of a build script -1. specify the default target ("main") requires "hw.exe" target -1. define the rule for "hw.exe" target - -### Bootstrapping Xake.Core - -The steps above assumes you've downloaded xake core assembly to .tools folder. -The next script demonstrates how to create the build script that does not require any installation steps: - -```fsharp -// boostrapping xake.core -System.Environment.CurrentDirectory <- __SOURCE_DIRECTORY__ - -let file = System.IO.Path.Combine("packages", "Xake.Core.dll") -if not (System.IO.File.Exists file) then - printf "downloading xake.core assembly..."; System.IO.Directory.CreateDirectory("packages") |> ignore - let url = "https://github.com/OlegZee/Xake/releases/download/v0.3.5/Xake.Core.dll" - use wc = new System.Net.WebClient() in wc.DownloadFile(url, file + "__"); System.IO.File.Move(file + "__", file) - printfn "" - -// xake build file body -#r @"packages/Xake.Core.dll" +#r "nuget: Xake, 3.0.0" open Xake +open Xake.Tasks -do xake {ExecOptions.Default with FileLog = "build.log"; Threads = 4 } { +do xakeScript { + rules [ + "main" <== ["hello"] - rule ("main" ==> ["helloworld.exe"]) - - rule("*.exe" ..> Csc { - CscSettings with - Src = !! (exe.Name -. "cs") - }) + command "hello" { + do! trace Message "Hello from Xake" + } + ] } ``` -## So what? - -Pretty much the same result could be obtained in traditional build system without ever mentioning declarative approach. However `xake` will not only create the requested binaries but would also remember the rules it followed and any dependencies it discovered. - -### Dependencies tracking - -The information recorded during the build allows `xake` to avoid redundant actions during current and subsequent runs. -Particularly in this example it will record: - -* "main" depends on "hw.exe" -* "hw.exe" rule requires csc compliler of highest available version -* "hw.exe" depends on `a*.exe` file mask -* `a*.*` was resolved to a single file `a.cs` -* the date/time of the `a.cs` is '2014-12-25 23:57:01' - -And during next run it will execute `main` rule only if at least one of following conditions is met: - -* there's no hw.exe -* you've installed newer .NET framework or removed the latest one -* file mask `a*.cs` resolves to a different file list -* the date of the `a.cs` was changed - -### Running multiple rules in parallel - -The other benefit the declarative approach brings is a parallel execution. Whenever `xake` see there's another pending task and free CPU core it executes the task. Maximal number of simultaneously executed tasks is controlled by a `XakeOptions.Threads` parameter is set by default to a number of processors (cores) in your system. - -And these both benefits do not require any additional efforts from you if you follow several simple rules. - -# Build script elements - -You've seen the structure of the script above. Let's reiterate it. - -## Script header - -You define the *references* to assemblies defining the tasks (if any) and you add the reference to main `xake.core.dll` assembly. You can also define *functions, variables and constants* here. +## Run a build script -## "Main" function +Run default target: -In fact this block is just the call to `xake` which is a special kind of computation expression accepting only the elements described below. - -### rule -Defines a rule for making file. - -Example: - -``` fsharp -rule ("out\\Tools.dll" ..> recipe { - - do! Csc { - CscSettings with - Src = !! "Tools/**/*.cs" - Ref = !! "out\\facade.dll" - } -}) +```bash +dotnet fsi build.fsx ``` +Run specific targets and options after a double separator: -There're several forms of rules including: - -* `rule ( => )` - creates a phony rule (the rule that does not create a file) -* `rule ( <== [targets])` - creates a phony rule which demands specified targets -* `rule ( ..> )` - rule for single file or group of files matching the specified wildcards pattern. The file and an optional matching groups can be accessed via getTargetFile and getRuleMatch methods -* `rule ( ..?> )` - allows to use function instead of file name or wildcards - -The following three options are now obsolete: - -* `rule ( %> fun out -> )` - rule for single file or group of files matching the specified wildcards pattern. The file and an optional matching groups will be passed to `out` argument of type RuleActionArgs -* `rule ( *?> fun outname -> )` - allows to use function instead of file name or wildcards -* `rule ( *> fun outname -> )` - the same as `%>` but the file is passed to action. Outdated option. - -> Notice: you are not bound to `outname` name above, you could change it to any other name. - -> Notice: the whole rule or rule action could be defined outside the `main` block. But you have to register the rule in main block. See the following example: - -```fsharp -#r @"../../bin/Xake.Core.dll" - -open Xake - -let mainRule = "hw.exe" ..> recipe { - do! Csc { - CscSettings with - Src = !! "a.cs" - } - } - -do xake {ExecOptions.Default with Threads = 4} { - - phony "build" (action { - do! need ["hw.exe"] - }) - - rule mainRule -} +```bash +dotnet fsi build.fsx -- -- clean build test ``` -### file patterns, named groups - -`file pattern` allows to define regular Ant-like patterns including name wildcards, recursion wildcard (`**`) and also **named groups**. - -E.g. the pattern `"(plat:*)-a.ss"` will match wildcard `"*-a.ss"` pattern and store '\*' part to a 'plat' group. +Pass variables: -``` fsharp -do xake {XakeOptions with Targets = ["out/abc.ss"]} { - rule ("(dir:*)/(file:*).(ext:ss)" ..> recipe { - - let! dir = getRuleMatch "dir" - let! file = getRuleMatch "file" - let! ext = getRuleMatch "ext" - Assert.AreEqual("out", dir) - Assert.AreEqual("abc", file) - Assert.AreEqual("ss", ext) - matchedAny := true - }) -} +```bash +dotnet fsi build.fsx -- -- build -d Version=1.2.3 ``` -### phony +## Core concepts -The same as `=>` above. Just another alias. +- Rules map targets to recipes +- Recipes define how targets are built +- Filesets collect files with Ant style masks +- Dependencies are recorded during recipe execution -### rules +When dependencies do not change, Xake skips rebuilds. -Allows to specify multiple rules passed in array. Syntactical sugar for reducing number of brackets. - -``` fsharp -rules [ +## Rule styles - "main" <== ["build"] - "build" <== ["out\\tools.dll"; "out\\main.exe"] +Preferred builder style: - "out\\main.exe" ..> recipe { - - do! Csc { - CscSettings with - Src = !! "Main/**/*.cs" + "Common/*.cs" - Ref = !! "out\\tools.dll" +```fsharp +rules [ + command "build" { + do! sh "dotnet build src/core -c Release" {} } - } - "out\\tools.dll" ..> recipe { - - do! Csc { - CscSettings with - Src = !! "Tools/**/*.cs" - Ref = !! "out\\facade.dll" + target "out/version.txt" { + let! ver = getVar "VERSION" + do! writeText <| Option.defaultValue "0.0.0" ver } - } - - "out\\facade.dll" ..> action { - do! Csc { - CscSettings with Src = !! "facade/**/*.cs" - } - } + "main" <== ["build"] ] ``` -### want - -Defines a default list of targets in case it was not set in script parameters (e.g. XakeOptions.Wants). - -### wantOverride - -The same as above but overrides the list of targets passed via parameters. - -### dryrun - -The `dryrun` keyword in the script instructs xake to simulate execution of the script without running the rules itself. Xake tool displays the dependencies list and execution time estimates. Respective command-line option is `--dryrun`. - -### filelog - -This option allows to specify the name of the log file and the detailization level. - -```fsharp - do xakeScript { - dryrun - filelog "errors.log" Verbosity.Chatty - rules [ - ... -``` - -## recipe: action computation - -Recipe body is computation expression of type *action*. This computation returns *Recipe* type and is very similar to -*async* computation. You could use both regular code (such as assignments/binding, loops and conditional expressions) -and do! notation within *action* body. - -See the functions allowing to access execution context within *action* body. - -> Notice the new name for 'action' is 'recipe'. They are completely equivalent. - -### Tasks, `do!` notation - -`do!` allows executing both async methods and *tasks*. *Task* is a regular F# function that is an *action* so that it returns *Recipe* type. - -Tasks are very simple: - -```fsharp -/// Copies the file -let cp (src: string) tgt = - action { - do! need [src] - File.Copy(src, tgt, true) - } -``` - -In case the action returns a value you could consume it using let-bang: -```fsharp - action { - let! error_code = system "ls" [] - if error_code <> 0 then failwith... - } -``` - -If the task (action) returns a value which you do not need use Recipe.Ignore: -```fsharp - action { - do! system "ls" [] |> Recipe.Ignore - } -``` - -### Exception handling - -`action` block allows to handle exceptions with idiomatic try/with and try/finally blocks. -```fsharp - phony "main" (action { - do! trace Level.Info "before try" // trace is standard action reporting to file/screen log - try - try - do! trace Level.Info "try" - failwith "Ouch" - with e -> - do! trace Level.Error "Error '%s' occured" e.Message - finally - printfn "Finally executed" - printfn "execution continues after try blocks" - }) -``` -Notice `trace` function just like any other actions (do! notation) cannot be used in `finally` blocks due to language limitations. +Operator style also works: -`WhenError` function is another option to handle errors. -```fsharp -action { - printfn "Some useful job" - do! action {failwith "err"} |> WhenError (fun _ -> printfn "caught the error") -} -``` -or this way ```fsharp rules [ - "main" => ( - WhenError ignore <| // ignore is a standard f# function accepting one argument - action { - printfn "Some useful job" - failwith "File IO error!" - printfn "This wont run" - }) + "main" <== ["build"; "test"] + "deploy" <<< ["build"; "test"; "package"] + "clean" => rm {dir "out"} ] ``` -### need - -`need` function is widely used internally and it is a key element for dependency tracking. Calling `need` ensures the requested files are built according to rules. -The action is paused until all dependencies are resolved and built. - -> In fact `need` is smart enough and it checks dependencies to determine whether to build file (execute respective rule) or not. In case you need the same file for multiple targets xake will build it only once. -> In case you need the dependency to rebuild every time it's requested you can use `alwaysRerun()` function described below. - -In the sample above `cp` function ensures the source file is build before it's copied to target folder. - -### Filesets - -* `getFiles` - (only allowed inside action) returns list of files specified by a fileset -* `ls` - creates a fileset for specified file mask. In case mask ends with "/" or "\" it returns directory list - -File masks follow Ant/Fake rules. - -### Other functions - -* `trace ` -* `getCtxOptions` - gets action context -* `getVar ` - gets the variable value (and records dependency!) -* `getEnv ` - gets environment variable (and records dependency!) -* `alwaysRerun` - instructs Xake to rebuild the target even if dependencies are not changed - -### Script variables - -Script variables are not F# variables. - -> TBD - -### Env module -Provides information about environment. - -Methods are: -* `isRunningOnMono` - executing under mono runtime (both in Windows and Unix) -* `isUnix` - is `true` is executing in Unix/OSX/Linux operating system -* `isWindows` - -,,- Windows operating system - -```fsharp -open Xake.Env - -let! _ = system (if isWindows then "dir" else "ls") -``` -### Tasks - -#### File tasks - -These tasks allows to perform various file operations. Using these tasks ensures the dependencies are properly resolved are recorded. -> TBD - -* `copyFile ` - copies single file (tracks dependency) -* `rm ` - removes the files by mask - -#### Dotnet tasks - -Set of tasks to build .NET applications. +## Useful links -* `Csc` - compiles C# files -* `MsBuild` - builds the project or solution using msbuild or xbuild -* `ResGen` - compiles resource file[s] +- Wiki home: https://github.com/OlegZee/Xake/wiki +- Introduction: https://github.com/OlegZee/Xake/wiki/Introduction +- Command line reference: https://github.com/OlegZee/Xake/wiki/Reference-%7C-Command-Line +- Rules reference: https://github.com/OlegZee/Xake/wiki/Reference-%7C-Rules +- Recipe reference: https://github.com/OlegZee/Xake/wiki/Reference-%7C-Recipe diff --git a/docs/tasks.md b/docs/tasks.md index 7e0380d..8c9aca0 100644 --- a/docs/tasks.md +++ b/docs/tasks.md @@ -1,108 +1,125 @@ -# Xake Tasks +# Xake tasks -// TBD +The examples below use current API style: -## Common tasks +```fsharp +#r "nuget: Xake, 3.0.0" +open Xake +open Xake.Tasks +``` -### Xake.SystemTasks +## Shell tasks -Module shell provides actions related to command shell. -Usage: +### sh recommended + +`sh` fails on non zero exit code by default. ```fsharp -open Xake.SystemTasks -let! errorlevel = system (fun o -> o) "ls" ["-lr"] +do! sh "dotnet build src/core -c Release" {} ``` -There several predefined functions for passing task settings. Here's the example with all three used: +With arguments and working directory: ```fsharp -open Xake.SystemTasks -do! system (useClr >> checkErrorLevel >> (workingDir "/etc")) "ls" ["-lr"] |> Recipe.Ignore +do! sh "dotnet" { + args ["test"; "src/tests"; "-c"; "Release"] + workdir "." + failonerror +} ``` -The first sets `UseClr` which instructs system command to run `mono ` on linux. The second one instructs **system** to fail when command returned non-zero errorlevel. The last one defines working directory. +Capture output: -> Notice there's another `system` action in Xake.CommonTasks. It lacks the first parameter (for settings) and is marked as obsolete. +```fsharp +let! code, lines = sh "dotnet --list-sdks" { resultAndOutput } +``` -## File tasks +## Copy tasks -These tasks allows to perform various file operations. Using these tasks ensures the dependencies are properly resolved are recorded. +Copy by file mask: -* `cp ` - copies the file -* `rm ` - removes the files by mask -* `writeText ` - writes content to target (of recipe) -* `copyFrom ` - copies file to target (of recipe) +```fsharp +do! cp {file "bin/*.dll"; todir "deploy"} +``` -### Dotnet tasks +Copy directory tree: -Set of tasks to build .NET applications. +```fsharp +do! cp {dir "bin"; todir "deploy"} +``` -* `Csc` - compiles C# files -* `Fsc` - F# compiler -* `MsBuild` - builds the project or solution using msbuild or xbuild -* `ResGen` - compiles resource file[s] +Copy from fileset: -### NETFX, NETFX-TARGET variables +```fsharp +do! cp { + files (fileset { + basedir "bin" + includes "*.dll" + includes "*.exe" + }) + todir "deploy" +} +``` -Xake allows using both Mono and .NET frameworks explicitly by defining `NETFX` variable. -Default behavior is to use the framework the script is running under. E.g. if running under Mono `fsharpi` recent mono toolset will be used. +Other copy helpers: -List of valid targets: +```fsharp +do! copyFile "src/App.config" "out/App.config" +"out/config.json" ..> copyFrom "src/config.json" +``` - | "net-20" | "net-2.0" | "2.0" - | "net-30" | "net-3.0" | "3.0" - | "net-35" | "net-3.5" | "3.5" - | "net-40c"| "net-4.0c" | "4.0-client" - | "net-40" | "net-4.0" | "4.0"| "4.0-full" - | "net-45" | "net-4.5" | "4.5"| "4.5-full" +## Remove tasks - | "mono-20" | "mono-2.0" | "2.0" - | "mono-35" | "mono-3.5" | "3.5" - | "mono-40" | "mono-4.0" | "4.0" - | "mono-45" | "mono-4.5" | "4.5" +Delete file or mask: -Use "2.0".."4.5" targets for multiplatform environments (will target mono-XXX being run under mono framework). +```fsharp +do! rm {file "temp/*.tmp"} +``` -The following script compiles application using 4.5 framework (mono or .net depending on running environment). +Delete directory: ```fsharp -#r @"packages/Xake/tools/Xake.Core.dll" -open Xake +do! rm {dir "out"} +``` + +Delete files from fileset: -do xake {ExecOptions.Default with } { - var "NETFX" "4.5" - rule ("main" ==> ["hw.exe"]) - - rule("hw.exe" *> fun exe -> action { - do! Csc { - CscSettings with - Out = exe - Src = !! "a.cs" - } - }) +```fsharp +do! rm { + files (fileset { + basedir "out" + includes "**/*.cache" + }) + verbose } ``` -`NETFX-TARGET` variable allow to specify target framework in the similar way, i.e. for all `csc` and `fsc` tasks. +## Inner recipe helpers + +Common helpers used inside `recipe`: -### F# compiler task +- `need` +- `needFiles` +- `dependsOn` +- `trace` +- `getVar` +- `getEnv` +- `getCtxOptions` +- `getTargetFile` +- `getTargetFullName` -Fsc task compiles fsharp project. +Example: ```fsharp -do! Fsc { - FscSettings with - Out = file - Src = sources - Ref = !! "bin/FSharp.Core.dll" + "bin/nunit.framework.dll" + "bin/Xake.Core.dll" - RefGlobal = ["mscorlib.dll"; "System.dll"; "System.Core.dll"] - Define = ["TRACE"] - CommandArgs = ["--optimize+"; "--warn:3"; "--warnaserror:76"; "--utf8output"] +recipe { + do! dependsOn !! "src/**/*.fs" + let! cfg = getVar "Config" + do! trace Info "Config: %A" cfg } ``` -Fsc uses most recent (from known) compiler version and allows to specify particular version. +## Notes -* global var `FSCVER` defines version for all fsc tasks. -* `FscVersion` field in compiler settings. Settings has higher priority. +- Prefer `Xake.Tasks` namespace in new scripts +- Prefer `sh`, `cp`, and `rm` builders over older legacy APIs +- Prefer typed variables with `Var.*` and `varschema` for better help output diff --git a/docs/todo.md b/docs/todo.md deleted file mode 100644 index 68def05..0000000 --- a/docs/todo.md +++ /dev/null @@ -1,80 +0,0 @@ -## TODOs and ideas - - * change the first page to a tutorial with script and usage examples - - * switch development to mono under windows - * idea: xake script as a task. Override/inherit variables. How to change variable on the fly is the original question. (we have got it out of the box, need more info) - * accept filemasks in 'need' parameters (WHY I added it here?, the use case is very unclear) - * detect changes in build script (internal changes), e.g. new target added that was not in .xake database - * dependencies tracking mode: automatically rebuild when dependency is changed, execute triggers allowing to start/stop the processes which lock/hold artifacts - * in-memory artifact (string or stream). Say in Gulp file is processed in-memory - * can the rules be abstract over artifacts - -### Refactorings - -* Artifact -> FileName of string, relative path, functions but not methods - -## Thoughts - -* idea: rule settings - * `"clean" {FailOnError = true} \*\*> file a -> action {}` - * `"clean" \!\*> file a -> action {}` - * `"clean" \*\*> file a -> action ({FailOnError = true}) {}` -* folder as a target: - * `want ["Viewer", "Designer"]` - * `rule "Viewer" -> fun folder -> action {need [folder <\\> "bin" <\\> folder <.> "exe"]...}` -* Filelist is not handy as it requires to cast all the time -* FileInfo is not good for the same reason: poorly composable and does not cover Directory well -* wildcards phony actions - -## Done (top is recent) - - * rules should accept #seq not just the list - * <<< for running tasks one by one. Current one runs in parallel only. - * complete copyFiles method - * put the rule's target file to ExecContext so that target could be get as let! target = getTarget() - * CscPath setting (cscpath in csc builder) allowing to define compiler path - * allow to specify F# compiler version - * overriding .xake database file name by options.DbFileName which defines relative db file name - * redirect compiler output to [Info] category, parse output and log warnings and errors respectively - * changed Artifact type to a File.T - * files case sensitivity is now platform dependent - * match groups in rule masks - * ls returns directory list in case it ends with "/" ("\") - * MSBuild task - * performance of rules lookup (takes 2s now) - * FSC task (f# compiler), self bootstrap - * command line: pass options, specify sequential/parallel targets - * progress indicator API (not documented and is not pluggable yet), Windows progress bar indicator - * let "main" be default rule so that I can skip 'want ["blablabla"]' in most scripts - * specify target framework for 4.0+ compiler - * MONO support - * explicitly target mono - * configure mono from registry - * probing paths for tools - * MSBUILD task - * CSC resources - * dependency rule: custom rule (Var) - * alwaysRerun, +rule with no deps - * имя файла-результата как аргумент (для оператора **>) - * задача system - * правило для группы файлов ("\*.rc" \*\*> fun f -> ...) - * файл (filepath) с разными операциями - * списки (fileset) - * матчинг имен артефактов/файлов + каталоги - * parameterized filesets (оператор для условной конкатенации списков ["a.cs"] &? debug ["debug.cs"]) - * два вида fileset - правила и вычисленный список - * CPU affinity as a script option - * complete abstraction over artifact (do not use fileinfo, resolve files when started using project dir) - * xake exec parameters (number of threads, log file, verbosity) - * параметризация сценария, сценарий как объект (main + rules) - * диагностика и лог (детально в файл, кратко на экран) - * exception handling and reporting - * clean (phony actions) - * do! alwaysRerun() to build target regardless dependencies are untouched - * incremental builds - * files - * database - * dependency rule: environment variable - * dependency rule: fileset change - * условное правило (*?> функция вместо маски) diff --git a/global.json b/global.json new file mode 100644 index 0000000..a7d2245 --- /dev/null +++ b/global.json @@ -0,0 +1,6 @@ +{ + "sdk": { + "rollForward": "major", + "version": "9.0.0" + } +} \ No newline at end of file diff --git a/readme.md b/readme.md index be9cbd1..d2ab596 100644 --- a/readme.md +++ b/readme.md @@ -1,16 +1,13 @@ Xake is a build utility that uses the full power of the F# programming language. Xake is inspired by [shake](https://github.com/ndmitchell/shake) build tool. -[![Build Status](https://travis-ci.org/xakebuild/Xake.svg?branch=dev)](https://travis-ci.org/xakebuild/Xake) +[![Build and Test](https://github.com/OlegZee/Xake/actions/workflows/build.yml/badge.svg)](https://github.com/OlegZee/Xake/actions/workflows/build.yml) ## Sample script The simple script looks like: ```fsharp -#r "paket: - nuget Xake ~> 1.1 prerelease - nuget Xake.Dotnet ~> 1.1 prerelease //" - +#r "nuget: Xake" open Xake open Xake.Dotnet @@ -25,7 +22,9 @@ do xakeScript { This script compiles helloworld assembly from helloworld.cs file. -To run this script: +## Getting started + +Make sure dotnet SDK 9.0+ is installed. 1. Clone the project: @@ -36,30 +35,49 @@ To run this script: ``` cd samples - dotnet restore dotnet-fake.csproj - dotnet fake run gettingstarted.fsx + dotnet fsi gettingstarted.fsx ``` + ``` + dotnet fsi features.fsx + ``` + ## Further reading -* See [the features.fsx](https://github.com/xakebuild/Xake/blob/dev/samples/features.fsx) script for various samples. -* We have the [introduction page](https://github.com/xakebuild/Xake/wiki/introduction) for you to learn more about Xake. -* And there're the [documentation notes](https://github.com/xakebuild/Xake/wiki) for more details. +* See [the features.fsx](https://github.com/OlegZee/Xake/blob/dev/samples/features.fsx) script for various samples. +* We have the [introduction page](https://github.com/OlegZee/Xake/wiki/Introduction) for you to learn more about Xake. +* And there're the [documentation notes](https://github.com/OlegZee/Xake/wiki) for more details. ## Build the project Once you cloned the repository you are ready to compile and test the binaries: ``` -dotnet restore build.proj -dotnet fake run build.fsx -- build test +dotnet fsi build.fsx -- -- build test ``` ... or use `build.cmd` (`build.sh`) in the root folder +## Getting started for Mono on Linux/OSX + +> This is untested and mono nowadays is poorly explored territory for me. + +Make sure mono with F# is installed and root certificates are imported: + +``` +sudo apt-get install mono-complete +sudo mozroots --import --sync +``` + +TBD + +## Documentation + +See [documentation](docs/overview.md) for more details. + ## References -* [documentation](https://github.com/xakebuild/Xake/wiki) +* [documentation](https://github.com/OlegZee/Xake/wiki) * [implementation notes](docs/implnotes.md) * [Shake manual](https://github.com/ndmitchell/shake/blob/master/docs/Manual.md) * [samples repository](https://github.com/xakebuild/Samples) diff --git a/samples/book/intro.fsx b/samples/book/intro.fsx index 6bd4156..8c06c72 100644 --- a/samples/book/intro.fsx +++ b/samples/book/intro.fsx @@ -1,6 +1,6 @@ -#r "paket: - nuget Xake ~> 1.1 prerelease - nuget Xake.Dotnet ~> 1.1 prerelease //" // (1) +#r "nuget: Xake, 1.1.4.427-beta" +#r "nuget: Xake.Dotnet, 1.1.4.7-beta" (1) + open Xake // (2) open Xake.Dotnet // (2.1) diff --git a/samples/catch_errors.fsx b/samples/catch_errors.fsx index 22f83ab..4f266a3 100644 --- a/samples/catch_errors.fsx +++ b/samples/catch_errors.fsx @@ -1,5 +1,4 @@ -#r "paket: nuget Xake ~> 1.1 prerelease //" - +#r "nuget: Xake, 2.0.0" open Xake do xakeScript { diff --git a/samples/features.fsx b/samples/features.fsx index b474bde..8765c58 100644 --- a/samples/features.fsx +++ b/samples/features.fsx @@ -1,19 +1,14 @@ -#r "paket: - nuget Xake ~> 1.1 prerelease - nuget Xake.Dotnet ~> 1.1 prerelease //" - -#if !FAKE -#load ".fake/features.fsx/intellisense.fsx" -#endif +#r "nuget: Xake, 2.9.6" +// #r "../out/netstandard2.0/Xake.dll" +#r "nuget: Xake.Dotnet, 1.1.4.7-beta" // This a sample Xake script to show off some features. // // USAGE: -// * `fake run` or -// * `dotnet restore && dotnet fake run` +// * `dotnet fsi features.fsx` or // -// Running particular target: -// * `dotnet fake run build.fsx -- clean` +// Running particular targets: +// * `dotnet fsi features.fsx -- -- clean main` open Xake open Xake.Tasks @@ -32,20 +27,44 @@ do xakeScript { // this rule does nothing but demands the other targets // the execution of the recipe is suspended until all demanded targets are built. // Targets are executed in parallel. Dependencies could be demanded in any part of recipe. - "main" => recipe { + command "main" { do! need ["tracetest"; "temp/a.exe"] - } + } // this is shorter way to express the same. See also `<==` and '<<<' operators. "main" => need ["tracetest"; "temp/a.exe"] - // .NET build rules - // build .net executable using full .net framework (or mono under unix) + // "phony" rule that produces no file but just removes the files + // `rm` recipe (Xake.Tasks namespace) allow to remove files and folders + "clean" => recipe { + do! rm {file "paket-files/*.*"} + do! rm {dir "out"} + do! rm {files (fileset { + includes "samplefile*" + }); verbose + } + } + + command "dotnet-version" { + // this rule will run `dotnet --version` command and print the result + do! sh "dotnet --version" {} + + // you can pass arguments and set options for the command + do! sh "dotnet" { + arg "--version" + logprefix "sh:dotnet-version" + } - // define a "phony rule", which has goal to produce a file - "clean" => rm {file "temp/a*"} + // Third option with `shellCmd` builder (wont fail on error by default) + let! error_code = shellCmd "dotnet" { + args [ "sdk"] + arg "check" + } + () + } - // rule to build an a.exe executable by using c# compiler + // .NET build rules + // build .net executable from C# sources using full .net framework (or mono under unix) // notice there's no "out" parameter: csc recipe will use the target file as an output "temp/a.exe" ..> csc {src (!!"temp/a.cs" + "temp/AssemblyInfo.cs")} @@ -63,7 +82,7 @@ do xakeScript { // this rule gets the version from VERSION script variable and generates // define the variable by running `dotnet fake run features.fsx -- -d VERSION:2.1.1` - "temp/AssemblyInfo.cs" ..> recipe { + target "temp/AssemblyInfo.cs" { let! envVersion = getVar("VERSION") let version = envVersion |> Option.defaultValue "1.0.0" do! writeText <| sprintf "[assembly: System.Reflection.AssemblyVersion(\"%s\")]" version @@ -107,17 +126,6 @@ do xakeScript { return () } - // "phony" rule that produces no file but just removes the files - // `rm` recipe (Xake.Tasks namespace) allow to remove files and folders - "clean" => recipe { - do! rm {file "paket-files/*.*"} - do! rm {dir "out"} - do! rm {files (fileset { - includes "samplefile*" - }); verbose - } - } - "libs" => recipe { // this command will copy all dlls to `lib` (flat files) do! cp {file "packages/mylib/net46/*.dll"; todir "lib"} @@ -161,12 +169,12 @@ do xakeScript { do! log "Fizz" // use let!, do! to call any recipe try - let j = ref 3 - while !j < 5 do - do! log (sprintf "j=%i" !j) - j := !j + 1 + let mutable j = 3 + while j < 5 do + do! log (sprintf "j=%i" j) + j <- j + 1 with _ -> - do! trace Error "Exception occured!" + do! trace Error "Exception occurred!" } // working with filesets and dependencies @@ -177,13 +185,16 @@ do xakeScript { // `let! files...` above records the dependency of `fileset` target from the set of files matching `src/*.cs` pattern. Whenever file is added or removed the dependency will be triggered // `do! needFiles` records that `fileset` depends on *contents* of each file matching the mask. It will trigger if file size or timestamp is changed + + // shorter way to express the same + do! dependsOn !! "src/*.cs" } // `trace` function demo // note: output verbosity is set to Diag to display all messages (see the "consolelog" instruction on top of xakeScript body) - "tracetest" => recipe { + command "tracetest" { do! trace Message "=============== Sample output follows this line\n\n" for loglevel in [Level.Command; Level.Message; Level.Error; Level.Warning; Level.Debug; Level.Info; Level.Verbose] do diff --git a/samples/gettingstarted.fsx b/samples/gettingstarted.fsx index 4a25411..6ac0bd5 100644 --- a/samples/gettingstarted.fsx +++ b/samples/gettingstarted.fsx @@ -1,6 +1,5 @@ -#r "paket: - nuget Xake ~> 1.1 prerelease - nuget Xake.Dotnet ~> 1.1 prerelease //" +#r "nuget: Xake, 2.0.0" +#r "nuget: Xake.Dotnet, 1.1.4.7-beta" open Xake open Xake.Dotnet diff --git a/samples/rmdir.fsx b/samples/rmdir.fsx index 938760c..439d819 100644 --- a/samples/rmdir.fsx +++ b/samples/rmdir.fsx @@ -1,4 +1,4 @@ -#r "paket: nuget Xake ~> 1.1 prerelease //" +#r "nuget: Xake, 1.1.4.427-beta" open Xake open Xake.Tasks diff --git a/src/core/CommonLib.fs b/src/core/CommonLib.fs index 0796fac..ec1488e 100644 --- a/src/core/CommonLib.fs +++ b/src/core/CommonLib.fs @@ -1,57 +1,55 @@ -namespace Xake +[] +module internal Xake.CommonLib -[] -module internal CommonLib = +type private CacheKey<'K> = K of 'K - type private CacheKey<'K> = K of 'K +/// +/// Creates a memoized function with the same signature. Performs memoization by storing run results to a cache. +/// +/// +let memoize f = + let cache = ref Map.empty + let lck = System.Object() + fun x -> + match !cache |> Map.tryFind (K x) with + | Some v -> v + | None -> + lock lck (fun () -> + match !cache |> Map.tryFind (K x) with + | Some v -> v + | None -> + let res = f x + cache := !cache |> Map.add (K x) res + res) - /// - /// Creates a memoized function with the same signature. Performs memoization by storing run results to a cache. - /// - /// - let memoize f = - let cache = ref Map.empty - let lck = System.Object() - fun x -> - match !cache |> Map.tryFind (K x) with - | Some v -> v - | None -> - lock lck (fun () -> - match !cache |> Map.tryFind (K x) with - | Some v -> v - | None -> - let res = f x - cache := !cache |> Map.add (K x) res - res) - - ///**Description** - /// Memoizes the recursive function. Memoized function is passed as first argument to f. - ///**Parameters** - /// * `f` - parameter of type `('a -> 'b) -> 'a -> 'b` The function to be memoized. - /// - ///**Output Type** - /// * `'a -> 'b` - /// - ///**Exceptions** - /// - let memoizeRec f = - let rec fn x = f fm x - and fm = fn |> memoize - in - fm +///**Description** +/// Memoizes the recursive function. Memoized function is passed as first argument to f. +///**Parameters** +/// * `f` - parameter of type `('a -> 'b) -> 'a -> 'b` The function to be memoized. +/// +///**Output Type** +/// * `'a -> 'b` +/// +///**Exceptions** +/// +let memoizeRec f = + let rec fn x = f fm x + and fm = fn |> memoize + in + fm - /// - /// Takes n first elements from a list. - /// - /// - let rec take cnt = function |_ when cnt <= 0 -> [] |[] -> [] |a::rest -> a :: (take (cnt-1) rest) +/// +/// Takes n first elements from a list. +/// +/// +let rec take cnt = function |_ when cnt <= 0 -> [] |[] -> [] |a::rest -> a :: (take (cnt-1) rest) - /// - /// Returns a list of unique values for a specific list. - /// - /// - let distinct ls = - ls |> - List.fold (fun map item -> if map |> Map.containsKey item then map else map |> Map.add item 1) Map.empty - |> Map.toList |> List.map fst +/// +/// Returns a list of unique values for a specific list. +/// +/// +let distinct ls = + ls |> + List.fold (fun map item -> if map |> Map.containsKey item then map else map |> Map.add item 1) Map.empty + |> Map.toList |> List.map fst diff --git a/src/core/Database.fs b/src/core/Database.fs index d36dca3..92580d2 100644 --- a/src/core/Database.fs +++ b/src/core/Database.fs @@ -4,8 +4,10 @@ module BuildLog = open Xake open System + /// Current database schema version. Old databases are discarded on version mismatch. let XakeDbVersion = "0.4" - + + /// In-memory build database mapping targets to their last build results. type Database = { Status : Map } (* API *) @@ -24,6 +26,7 @@ module BuildLog = let internal addResult db result = { db with Status = result.Targets |> List.fold (fun m i -> Map.add i result m) db.Status } +/// Type alias for MailboxProcessor used as a message-passing agent. type 't Agent = 't MailboxProcessor module Storage = @@ -59,7 +62,7 @@ module Storage = | FileDep _ -> 1 | EnvVar _ -> 2 | Var _ -> 3 - | AlwaysRerun _ -> 4 + | AlwaysRerun -> 4 | GetFiles _ -> 5) [| wrap (ArtifactDep, fun (ArtifactDep f | OtherwiseFail f) -> f) target wrap (FileDep, fun (FileDep(f, ts) | OtherwiseFail (f, ts)) -> (f, ts)) (pair file date) @@ -90,6 +93,8 @@ module Storage = module private impl = open System.IO open Persist + + let makeBkpath dbpath = dbpath <.> "bak" let writeHeader w = let h = @@ -101,7 +106,7 @@ module Storage = let openDatabaseFile dbpath (logger : ILogger) = let log = logger.Log let resultPU = Persist.result - let bkpath = dbpath <.> "bak" + let bkpath = makeBkpath dbpath // if exists backup restore if File.Exists(bkpath) then log Level.Message "Backup file found ('%s'), restoring db" @@ -126,9 +131,7 @@ module Storage = recordCount := !recordCount + 1 // if fails create new with ex -> - log Level.Error - "Failed to read database, so recreating. Got \"%s\"" - <| ex.ToString() + log Warning "Failed to read database, so recreating. Got \"%s\"" <| ex.ToString() try File.Delete(dbpath) with _ -> () @@ -149,7 +152,8 @@ module Storage = if dbwriter.BaseStream.Position = 0L then writeHeader dbwriter db, dbwriter - type DatabaseApi = + /// Messages accepted by the database agent. + type DatabaseApi = | GetResult of Target * AsyncReplyChannel> | Store of BuildResult | Close @@ -192,6 +196,38 @@ module Storage = } loop (!db)) + /// + /// In-memory database for use when NoPersist = true. + /// Tracks build results within the session but does not write to disk. + /// + let noopDb () = + MailboxProcessor.Start(fun mbox -> + let rec loop (db: Database) = async { + let! msg = mbox.Receive() + match msg with + | GetResult (key, ch) -> + db.Status |> Map.tryFind key |> ch.Reply + return! loop db + | Store result -> + return! loop (result |> addResult db) + | Close -> () + | CloseWait ch -> ch.Reply () + } + loop { Status = Map.empty }) + + /// Deletes existing database and backup files to reset the build log. Should be called before starting the build. + let cleanupDb dbpath (logger : ILogger) = + let bkpath = impl.makeBkpath dbpath + [dbpath; bkpath] + |> List.iter (fun path -> + if System.IO.File.Exists(path) then + try + System.IO.File.Delete(path) + logger.Log Level.Message "Deleted database file: %s" path + with ex -> + logger.Log Level.Warning "Failed to delete %s: %s" path (ex.Message) + ) + /// Utility methods to manipulate build stats module internal Step = diff --git a/src/core/DependencyAnalysis.fs b/src/core/DependencyAnalysis.fs index 2f747b6..a9087fd 100644 --- a/src/core/DependencyAnalysis.fs +++ b/src/core/DependencyAnalysis.fs @@ -20,12 +20,13 @@ let TimeCompareToleranceMs = 10.0 /// /// /// -let getExecTime ctx target = +let getExecTime (ctx: ExecContext) target = (fun ch -> Storage.GetResult(target, ch)) |> ctx.Db.PostAndReply |> Option.fold (fun _ r -> r.Steps |> List.sumBy (fun s -> s.OwnTime)) 0 /// Gets single dependency state and reason of a change. -let getDepState getVar getFileList (getChangedDeps: Target -> ChangeReason list) = function +let getDepState getVar getFileList (getChangedDeps: Target -> ChangeReason list) x = + match x with | FileDep (a:File, wrtime) when not((File.exists a) && abs((File.getLastWriteTime a - wrtime).TotalMilliseconds) < TimeCompareToleranceMs) -> let dbgInfo = File.exists a |> function | false -> "file does not exists" @@ -68,7 +69,7 @@ let getDepState getVar getFileList (getChangedDeps: Target -> ChangeReason list) /// /// gets state for nested dependency /// The target to analyze -let getChangeReasons ctx getTargetDeps target = +let getChangeReasons (ctx: ExecContext) getTargetDeps target = // separates change reason into two lists and collabses FilesChanged all into one let collapseFilesChanged reasons = @@ -86,7 +87,7 @@ let getChangeReasons ctx getTargetDeps target = [ChangeReason.Other "No dependencies", Some "It means target is not \"pure\" and depends on something beyond our control (oracle)"] | Some {BuildResult.Depends = depends; Targets = result} -> - let depState = getDepState (Util.getVar ctx.Options) (toFileList ctx.Options.ProjectRoot) getTargetDeps + let depState = getDepState (Util.getVar ctx.Vars) (toFileList ctx.Options.ProjectRoot) getTargetDeps depends |> List.map depState diff --git a/src/core/ExecCore.fs b/src/core/ExecCore.fs index 2e50fe8..0dad347 100644 --- a/src/core/ExecCore.fs +++ b/src/core/ExecCore.fs @@ -1,381 +1,315 @@ -namespace Xake - -module internal ExecCore = +module internal Xake.ExecCore + +open System.Text.RegularExpressions +open DependencyAnalysis + +open Storage +open WorkerPool + +/// Returns the current recipe execution context as a tuple of build result and execution context. +let getCtx() = Recipe (fun (r,c) -> async {return (r,c)}) + +/// Writes a formatted message to the build log at the specified logging level. +let traceLog (level:Logging.Level) fmt = + let write s = recipe { + let! ctx = getCtx() + return ctx.Logger.Log level "%s" s + } + Printf.kprintf write fmt + +let wildcardsRegex = Regex(@"\*\*|\*|\?", RegexOptions.Compiled) +let patternTagRegex = Regex(@"\((?'tag'\w+?)\:[^)]+\)", RegexOptions.Compiled) +let replace (regex:Regex) (evaluator: Match -> string) text = regex.Replace(text, evaluator) +let ifNone x = function |Some x -> x | _ -> x + +/// Substitutes wildcard and named capture group matches into a file pattern. +/// Positional wildcards (*, **, ?) are replaced by index, named groups by tag. +let applyWildcards = function + | None -> id + | Some matches -> + fun pat -> + let mutable i = 0 + let evaluator m = + i <- i + 1 + matches |> Map.tryFind (i.ToString()) |> ifNone "" + let evaluatorTag (m: Match) = + matches |> (Map.tryFind m.Groups.["tag"].Value) |> ifNone "" + pat + |> replace wildcardsRegex evaluator + |> replace patternTagRegex evaluatorTag + +/// Finds the first rule whose pattern matches the given target. +/// Returns the matched rule, captured groups, and the full list of targets it produces. +let locateRule (Rules rules) projectRoot target = + let matchRule rule = + match rule, target with + + |FileConditionRule (meetCondition,_), FileTarget file when file |> File.getFullName |> meetCondition -> + //writeLog Level.Debug "Found conditional pattern '%s'" name + // TODO let condition rule extracting named groups + Some (rule,[],[target]) + + |FileRule (pattern,_), FileTarget file -> + file + |> File.getFullName + |> Path.matchGroups pattern projectRoot + |> Option.map (fun groups -> rule,groups,[target]) + + |MultiFileRule (patterns, _), FileTarget file -> + let fname = file |> File.getFullName + patterns + |> List.tryPick(fun pattern -> + Path.matchGroups pattern projectRoot fname + |> Option.map(fun groups -> groups, pattern) + ) + |> Option.map (fun (groups, _) -> + let generateName = applyWildcards (Map.ofList groups |> Some) + + let targets = patterns |> List.map (generateName >> () projectRoot >> File.make >> FileTarget) + rule, groups, targets) + + |PhonyRule (pattern,_), PhonyAction phony -> + // printfn $"Phony rule {phony}, pattern {pattern}" + // Some (rule, [], [target]) + phony + |> Path.matchGroups pattern "" + |> Option.map (fun groups -> rule,groups,[target]) + + | _ -> None + + rules |> List.tryPick matchRule + +/// Global counter for assigning ordinals to tasks submitted to the worker pool. +let refTaskOrdinal = ref 0 + +/// Creates a new execution context for a task, assigning it a unique ordinal and a prefixed logger. +let newTaskContext targets matches ctx = + let ordinal = System.Threading.Interlocked.Increment(refTaskOrdinal) + let prefix = ordinal |> sprintf "%i> " + in + {ctx with + Ordinal = ordinal; Logger = PrefixLogger prefix ctx.Engine.RootLogger + Targets = targets + RuleMatches = matches + } + +/// Executes a single target: locates the matching rule, submits the work to the +/// scheduler, and returns the target, its execution status, and a dependency record. +/// If no rule matches but a corresponding file exists, returns JustFile status. +/// Raises XakeException when neither a rule nor a file is found. +let rec execOne (ctx: ExecContext) target = + + let run ruleMatches action targets = + let primaryTarget = targets |> List.head + async { + match ctx.NeedRebuild targets with + | true -> + let taskContext = newTaskContext targets ruleMatches ctx + do ctx.Logger.Log Command "Started %s as task %i" primaryTarget.ShortName taskContext.Ordinal - open System.Text.RegularExpressions - open DependencyAnalysis + do Progress.TaskStart primaryTarget |> ctx.Progress.Post - /// Default options - [] - let XakeOptions = ExecOptions.Default + let startResult = {BuildLog.makeResult targets with Steps = [Step.start "all"]} + let! (result,_) = action (startResult, taskContext) + let result = Step.updateTotalDuration result - open WorkerPool - open Storage + Store result |> ctx.Db.Post - /// Writes the message with formatting to a log - let traceLog (level:Logging.Level) fmt = - let write s = action { - let! ctx = getCtx() - return ctx.Logger.Log level "%s" s - } - Printf.kprintf write fmt - - let wildcardsRegex = Regex(@"\*\*|\*|\?", RegexOptions.Compiled) - let patternTagRegex = Regex(@"\((?'tag'\w+?)\:[^)]+\)", RegexOptions.Compiled) - let replace (regex:Regex) (evaluator: Match -> string) text = regex.Replace(text, evaluator) - let ifNone x = function |Some x -> x | _ -> x - - let (|Dump|Dryrun|Run|) (opts:ExecOptions) = - match opts with - | _ when opts.DumpDeps -> Dump - | _ when opts.DryRun -> Dryrun - | _ -> Run - - let applyWildcards = function - | None -> id - | Some matches -> - fun pat -> - let mutable i = 0 - let evaluator m = - i <- i + 1 - matches |> Map.tryFind (i.ToString()) |> ifNone "" - let evaluatorTag (m: Match) = - matches |> (Map.tryFind m.Groups.["tag"].Value) |> ifNone "" - pat - |> replace wildcardsRegex evaluator - |> replace patternTagRegex evaluatorTag - - // locates the rule - let locateRule (Rules rules) projectRoot target = - let matchRule rule = - match rule, target with - - |FileConditionRule (meetCondition,_), FileTarget file when file |> File.getFullName |> meetCondition -> - //writeLog Level.Debug "Found conditional pattern '%s'" name - // TODO let condition rule extracting named groups - Some (rule,[],[target]) - - |FileRule (pattern,_), FileTarget file -> - file - |> File.getFullName - |> Path.matchGroups pattern projectRoot - |> Option.map (fun groups -> rule,groups,[target]) - - |MultiFileRule (patterns, _), FileTarget file -> - let fname = file |> File.getFullName - patterns - |> List.tryPick(fun pattern -> - Path.matchGroups pattern projectRoot fname - |> Option.map(fun groups -> groups, pattern) - ) - |> Option.map (fun (groups, pattern) -> - let generateName = applyWildcards (Map.ofList groups |> Some) - - let targets = patterns |> List.map (generateName >> () projectRoot >> File.make >> FileTarget) - rule, groups, targets) - - |PhonyRule (name,_), PhonyAction phony when phony = name -> - // writeLog Verbose "Found phony pattern '%s'" name - Some (rule, [], [target]) - - | _ -> None - - rules |> List.tryPick matchRule - - let reportError ctx error details = - do ctx.Logger.Log Error "Error '%s'. See build.log for details" error - do ctx.Logger.Log Verbose "Error details are:\n%A\n\n" details - - let raiseError ctx error details = - do reportError ctx error details - raise (XakeException(sprintf "Script failed (error code: %A)\n%A" error details)) - - // Ordinal of the task being added to a task pool - let refTaskOrdinal = ref 0 - - /// - /// Creates a context for a new task - /// - let newTaskContext targets matches ctx = - let ordinal = System.Threading.Interlocked.Increment(refTaskOrdinal) - let prefix = ordinal |> sprintf "%i> " - in - {ctx with - Ordinal = ordinal; Logger = PrefixLogger prefix ctx.RootLogger - Targets = targets - RuleMatches = matches + do Progress.TaskComplete primaryTarget |> ctx.Progress.Post + do ctx.Logger.Log Command "Completed %s in %A ms (wait %A ms)" primaryTarget.ShortName (Step.lastStep result).OwnTime (Step.lastStep result).WaitTime + return Succeed + | false -> + do ctx.Logger.Log Command "Skipped %s (up to date)" primaryTarget.ShortName + return Skipped } - // executes single artifact - let rec execOne ctx target = - - let run ruleMatches action targets = - let primaryTarget = targets |> List.head - async { - match ctx.NeedRebuild targets with - | true -> - let taskContext = newTaskContext targets ruleMatches ctx - do ctx.Logger.Log Command "Started %s as task %i" primaryTarget.ShortName taskContext.Ordinal - - do Progress.TaskStart primaryTarget |> ctx.Progress.Post - - let startResult = {BuildLog.makeResult targets with Steps = [Step.start "all"]} - let! (result,_) = action (startResult, taskContext) - let result = Step.updateTotalDuration result - - Store result |> ctx.Db.Post - - do Progress.TaskComplete primaryTarget |> ctx.Progress.Post - do ctx.Logger.Log Command "Completed %s in %A ms (wait %A ms)" primaryTarget.ShortName (Step.lastStep result).OwnTime (Step.lastStep result).WaitTime - return ExecStatus.Succeed - | false -> - do ctx.Logger.Log Command "Skipped %s (up to date)" primaryTarget.ShortName - return ExecStatus.Skipped - } - - let getAction = function - | FileRule (_, a) - | FileConditionRule (_, a) - | MultiFileRule (_, a) - | PhonyRule (_, a) -> a - - // result expression is... - match target |> locateRule ctx.Rules ctx.Options.ProjectRoot with - | Some(rule,groups,targets) -> - let groupsMap = groups |> Map.ofSeq - let (Recipe action) = rule |> getAction - async { - let! waitTask = (fun channel -> Run(target, targets, run groupsMap action targets, channel)) |> ctx.TaskPool.PostAndAsyncReply - let! status = waitTask - return target, status, ArtifactDep target - } - | None -> - target |> function - | FileTarget file when File.exists file -> - async.Return <| (target, ExecStatus.JustFile, FileDep (file, File.getLastWriteTime file)) - | _ -> raiseError ctx (sprintf "Neither rule nor file is found for '%s'" target.FullName) "" - - /// - /// Executes several artifacts in parallel. - /// - and execParallel ctx = List.map (execOne ctx) >> Seq.ofList >> Async.Parallel - - /// - /// Gets the status of dependency artifacts (obtained from 'need' calls). - /// - /// - /// ExecStatus.Succeed,... in case at least one dependency was rebuilt - /// - and execNeed ctx targets : Async = + let getAction = function + | FileRule (_, a) + | FileConditionRule (_, a) + | MultiFileRule (_, a) + | PhonyRule (_, a) -> a + + // result expression is... + match target |> locateRule ctx.Options.Rules ctx.Options.ProjectRoot with + | Some(rule,groups,targets) -> + let groupsMap = groups |> Map.ofSeq + let (Recipe action) = rule |> getAction async { - let primaryTarget = ctx.Targets |> List.head - primaryTarget |> (Progress.TaskSuspend >> ctx.Progress.Post) - - do ctx.Throttler.Release() |> ignore - let! statuses = targets |> execParallel ctx - do! ctx.Throttler.WaitAsync(-1) |> Async.AwaitTask |> Async.Ignore - - primaryTarget |> (Progress.TaskResume >> ctx.Progress.Post) - - let dependencies = statuses |> Array.map (fun (_,_,x) -> x) |> List.ofArray in - return - (match statuses |> Array.exists (fun (_,x,_) -> x = ExecStatus.Succeed) with - |true -> ExecStatus.Succeed - |false -> ExecStatus.Skipped), dependencies + let! waitTask = (fun channel -> Run(target, targets, run groupsMap action targets, channel)) |> (Scheduler.pool ctx.Engine.Scheduler).PostAndAsyncReply + let! status = waitTask + return target, status, ArtifactDep target } - - /// phony actions are detected by their name so if there's "clean" phony and file "clean" in `need` list if will choose first - let makeTarget ctx name = - let (Rules rules) = ctx.Rules - let isPhonyRule nm = function |PhonyRule (n,_) when n = nm -> true | _ -> false - in - match rules |> List.exists (isPhonyRule name) with - | true -> PhonyAction name - | _ -> ctx.Options.ProjectRoot name |> File.make |> FileTarget - - /// Implementation of "dry run" - let dryRun ctx options (groups: string list list) = + | None -> + target |> function + | FileTarget file when File.exists file -> + async.Return <| (target, ExecStatus.JustFile, FileDep (file, File.getLastWriteTime file)) + | _ -> + let errorText = sprintf "Neither rule nor file is found for '%s'" target.FullName + do ctx.Logger.Log Error "%s" errorText + raise (XakeException errorText) + +/// Executes multiple targets in parallel and collects their results. +and execParallel ctx = List.map (execOne ctx) >> Seq.ofList >> Async.Parallel + +/// Executes dependency targets in parallel, yielding the current scheduler slot while waiting. +/// Returns Succeed if at least one dependency was rebuilt, Skipped otherwise, +/// along with the list of recorded dependencies. +and execNeed (ctx: ExecContext) targets : Async = + async { + let primaryTarget = ctx.Targets |> List.head + primaryTarget |> (Progress.TaskSuspend >> ctx.Progress.Post) + + let! statuses = Scheduler.withYieldedSlot ctx.Engine.Scheduler (targets |> execParallel ctx) + + primaryTarget |> (Progress.TaskResume >> ctx.Progress.Post) + + let dependencies = statuses |> Array.map (fun (_,_,x) -> x) |> List.ofArray in + return + (match statuses |> Array.exists (fun (_,x,_) -> x = ExecStatus.Succeed) with + |true -> Succeed + |false -> Skipped), dependencies + } + +/// Resolves a target name to a PhonyAction if a matching phony rule exists, otherwise to a FileTarget. +/// Phony actions take precedence over files with the same name. +let makeTarget (ctx: ExecContext) name = + let (Rules rules) = ctx.Options.Rules + let isPhonyRule nm = function + |PhonyRule (pattern,_) -> + nm |> Path.matchGroups pattern "" |> Option.isSome + | _ -> false + in + match rules |> List.exists (isPhonyRule name) with + | true -> PhonyAction name + | _ -> ctx.Options.ProjectRoot name |> File.make |> FileTarget + +/// Recursively flattens an AggregateException into its leaf exceptions. +let rec unwindAggEx (e:System.Exception) = seq { + match e with + | :? System.AggregateException as a -> yield! a.InnerExceptions |> Seq.collect unwindAggEx + | a -> yield a + } + +/// Executes a list of async computations sequentially, collecting results in order. +let rec runSeq<'r> :Async<'r> list -> Async<'r list> = + List.fold + (fun rest i -> async { + let! tail = rest + let! head = i + return head::tail + }) + (async {return []}) + +/// Maps a function over the result of an async computation. +let asyncMap f c = async.Bind(c, f >> async.Return) + +/// Runs the full build pipeline for the given target groups. +/// Each group is executed sequentially; targets within a group run in parallel. +/// Returns the combined list of target/status/dependency results. +let runBuild (ctx: ExecContext) groups = + let options = ctx.Options + + let runTargets ctx targets = let getDeps = getChangeReasons ctx |> memoizeRec - // getPlainDeps getDeps (getExecTime ctx) - do ctx.Logger.Log Command "Running (dry) targets %A" groups - let doneTargets = System.Collections.Hashtable() - - let print f = ctx.Logger.Log Info f - let indent i = String.replicate i " " - - let rec showDepStatus ii reasons = - reasons |> function - | ChangeReason.Other reason -> - print "%sReason: %s" (indent ii) reason - | ChangeReason.Depends t -> - print "%sDepends '%s' - changed target" (indent ii) t.ShortName - | ChangeReason.DependsMissingTarget t -> - print "%sDepends on '%s' - missing target" (indent ii) t.ShortName - | ChangeReason.FilesChanged (file:: rest) -> - print "%sFile is changed '%s' %s" (indent ii) file (if List.isEmpty rest then "" else sprintf " and %d more file(s)" <| List.length rest) - | reasons -> - do print "%sSome reason %A" (indent ii) reasons - () - let rec displayNestedDeps ii = + let needRebuild (target: Target) = + getDeps >> function - | ChangeReason.DependsMissingTarget t - | ChangeReason.Depends t -> - showTargetStatus ii t - | _ -> () - and showTargetStatus ii target = - if not <| doneTargets.ContainsKey(target) then - doneTargets.Add(target, 1) - let deps = getDeps target - if not <| List.isEmpty deps then - let execTimeEstimate = getExecTime ctx target - do ctx.Logger.Log Command "%sRebuild %A (~%Ams)" (indent ii) target.ShortName execTimeEstimate - deps |> List.iter (showDepStatus (ii+1)) - deps |> List.iter (displayNestedDeps (ii+1)) - - let targetGroups = makeTarget ctx |> List.map |> List.map <| groups in - let toSec v = float (v / 1) * 0.001 - let endTime = Progress.estimateEndTime (getDurationDeps ctx getDeps) options.Threads targetGroups |> toSec - - targetGroups |> List.collect id |> List.iter (showTargetStatus 0) - let alldeps = targetGroups |> List.collect id |> List.collect getDeps - if List.isEmpty alldeps then - ctx.Logger.Log Message "\n\n\tNo changed dependencies. Nothing to do.\n" - else - let parallelismMsg = - let endTimeTotal = Progress.estimateEndTime (getDurationDeps ctx getDeps) 1 targetGroups |> toSec - if options.Threads > 1 && endTimeTotal > endTime * 1.05 then - sprintf "\n\tTotal tasks duration is (estimate) in %As\n\tParallelist degree: %.2f" endTimeTotal (endTimeTotal / endTime) - else "" - ctx.Logger.Log Message "\n\n\tBuild will be completed (estimate) in %As%s\n" endTime parallelismMsg - - let rec unwindAggEx (e:System.Exception) = seq { - match e with - | :? System.AggregateException as a -> yield! a.InnerExceptions |> Seq.collect unwindAggEx - | a -> yield a - } - - let rec runSeq<'r> :Async<'r> list -> Async<'r list> = - List.fold - (fun rest i -> async { - let! tail = rest - let! head = i - return head::tail - }) - (async {return []}) - - let asyncMap f c = async.Bind(c, f >> async.Return) - - /// Runs the build (main function of xake) - let runBuild ctx options groups = - - let runTargets ctx options targets = - let getDeps = getChangeReasons ctx |> memoizeRec - - let needRebuild (target: Target) = - getDeps >> - function - | [] -> false, "" - | ChangeReason.Other reason::_ -> true, reason - | ChangeReason.Depends t ::_ -> true, "Depends on target " + t.ShortName - | ChangeReason.DependsMissingTarget t ::_ -> true, sprintf "Depends on target %s (missing)" t.ShortName - | ChangeReason.FilesChanged (file::_) ::_ -> true, "File(s) changed " + file - | reasons -> true, sprintf "Some reason %A" reasons - >> - function - | false, _ -> false - | true, reason -> - do ctx.Logger.Log Info "Rebuild %A: %s" target.ShortName reason - true - <| target - // todo improve output by printing primary target - - async { - do ctx.Logger.Log Info "Build target list %A" targets - - let progressSink = Progress.openProgress (getDurationDeps ctx getDeps) options.Threads targets options.Progress - let stepCtx = {ctx with NeedRebuild = List.exists needRebuild; Progress = progressSink} - - try - return! targets |> execParallel stepCtx - finally - do Progress.Finish |> progressSink.Post - } - - groups |> List.map - (List.map (makeTarget ctx) >> (runTargets ctx options)) - |> runSeq - |> asyncMap (Array.concat >> List.ofArray) - - /// Executes the build script - let runScript options rules = - let logger = CombineLogger (ConsoleLogger options.ConLogLevel) options.CustomLogger - - let logger = - match options.FileLog, options.FileLogLevel with - | null,_ | "",_ - | _,Verbosity.Silent -> logger - | logFileName,level -> CombineLogger logger (FileLogger logFileName level) - - let (throttler, pool) = WorkerPool.create logger options.Threads - - let db = Storage.openDb (options.ProjectRoot options.DbFileName) logger - - let ctx = { - Ordinal = 0 - TaskPool = pool; Throttler = throttler - Options = options; Rules = rules - Logger = logger; RootLogger = logger; Db = db - Progress = Progress.emptyProgress() - NeedRebuild = fun _ -> false - Targets = [] - RuleMatches = Map.empty - } - - logger.Log Info "Options: %A" options - - // splits list of targets ["t1;t2"; "t3;t4"] into list of list. - let targetLists = - options.Targets |> + | [] -> false, "" + | Other reason::_ -> true, reason + | Depends t ::_ -> true, "Depends on target " + t.ShortName + | DependsMissingTarget t ::_ -> true, sprintf "Depends on target %s (missing)" t.ShortName + | FilesChanged (file::_) ::_ -> true, "File(s) changed " + file + | reasons -> true, sprintf "Some reason %A" reasons + >> function - | [] -> - do logger.Log Level.Message "No target(s) specified. Defaulting to 'main'" - [["main"]] - | tt -> - tt |> List.map (fun (s: string) -> s.Split(';', '|') |> List.ofArray) + | false, _ -> false + | true, reason -> + do ctx.Logger.Log Info "Rebuild %A: %s" target.ShortName reason + true + <| target + // todo improve output by printing primary target - try - match options with - | Dump -> - do logger.Log Level.Command "Dumping dependencies for targets %A" targetLists - targetLists |> List.iter (List.map (makeTarget ctx) >> (dumpDeps ctx)) - | Dryrun -> - targetLists |> (dryRun ctx options) - | _ -> - let start = System.DateTime.Now - try - targetLists |> (runBuild ctx options) |> Async.RunSynchronously |> ignore - ctx.Logger.Log Message "\n\n Build completed in %A\n" (System.DateTime.Now - start) - with | exn -> - let th = if options.FailOnError then raiseError else reportError - let errors = exn |> unwindAggEx |> Seq.map (fun e -> e.Message) in - th ctx (exn.Message + "\n" + (errors |> String.concat "\r\n ")) exn - ctx.Logger.Log Message "\n\n\tBuild failed after running for %A\n" (System.DateTime.Now - start) - exit 2 - finally - db.PostAndReply Storage.CloseWait - Logging.FlushLogs() + async { + do ctx.Logger.Log Info "Build target list %A" targets - /// "need" implementation - let need targets = - action { - let startTime = System.DateTime.Now + let progressSink = Progress.openProgress (getDurationDeps ctx getDeps) options.Threads targets ctx.ShowProgress + let stepCtx = {ctx with NeedRebuild = List.exists needRebuild; Progress = progressSink} - let! ctx = getCtx() - let! _,deps = targets |> execNeed ctx + try + return! targets |> execParallel stepCtx + finally + do Progress.Finish |> progressSink.Post + } - let totalDuration = int (System.DateTime.Now - startTime).TotalMilliseconds * 1 - let! result = getResult() - let result' = {result with Depends = result.Depends @ deps} |> (Step.updateWaitTime totalDuration) - do! setResult result' + groups |> List.map + (List.map (makeTarget ctx) >> (runTargets ctx)) + |> runSeq + |> asyncMap (Array.concat >> List.ofArray) + +/// Creates the shared execution context and returns it together with a finalize callback. +/// The finalize callback closes the database, disposes the scheduler, and flushes logs. +let createContextCore (options: EngineOptions) (db: Agent) vars showProgress = + let logger = options.Logger + let scheduler = Scheduler.create logger options.Threads + + let finalize () = + db.PostAndReply Storage.CloseWait + (scheduler :> System.IDisposable).Dispose() + FlushLogs() + + let engineState = { + Options = options + Db = db + Scheduler = scheduler + RootLogger = logger + } + + let ctx = { + Ordinal = 0 + Engine = engineState + Logger = logger + Progress = Progress.emptyProgress() + NeedRebuild = fun _ -> false + Targets = [] + RuleMatches = Map.empty + Vars = vars + ShowProgress = showProgress } + ctx, finalize + +/// Creates an execution context for engine/library mode with no persistence and no progress display. +let createContext (options: EngineOptions) vars = + let db = Storage.noopDb () + createContextCore options db vars false + +/// Builds a single target by name and returns its execution status. +/// Sets up dependency analysis, progress tracking, and scheduler context for the build. +let demandTarget (ctx: ExecContext) (targetName: string) : Async = + async { + let target = makeTarget ctx targetName + let getDeps = getChangeReasons ctx |> memoizeRec + let needRebuild (t: Target) = + getDeps t |> function | [] -> false | _ -> true + let progressSink = Progress.openProgress (getDurationDeps ctx getDeps) ctx.Engine.Options.Threads [target] ctx.ShowProgress + let stepCtx = {ctx with NeedRebuild = List.exists needRebuild; Progress = progressSink} + try + let! (_, status, _) = execOne stepCtx target + return status + finally + Progress.Finish |> progressSink.Post + } + +/// Recipe action that declares dependencies on the given targets. +/// Executes them in parallel, records their dependencies, and updates step wait time. +let need targets = recipe { + let startTime = System.DateTime.Now + + let! ctx = getCtx() + let! _,deps = targets |> execNeed ctx + + let totalDuration = int (System.DateTime.Now - startTime).TotalMilliseconds * 1 + let! result = getResult() + let result' = {result with Depends = result.Depends @ deps} |> (Step.updateWaitTime totalDuration) + do! setResult result' +} diff --git a/src/core/ExecTypes.fs b/src/core/ExecTypes.fs index 5f87557..76d161c 100644 --- a/src/core/ExecTypes.fs +++ b/src/core/ExecTypes.fs @@ -1,94 +1,74 @@ -namespace Xake +namespace Xake -open System.Threading +open Xake.WorkerPool -/// Script execution options -type ExecOptions = { - /// Defines project root folder - ProjectRoot : string - /// Maximum number of rules processed simultaneously. - Threads: int - - /// custom logger - CustomLogger: ILogger - - /// Log file and verbosity level. - FileLog: string - FileLogLevel: Verbosity - - /// Console output verbosity level. Default is Warn - ConLogLevel: Verbosity - /// Overrides "want", i.e. target list - Targets: string list - - /// Global script variables - Vars: (string * string) list - - /// Defines whether `run` should throw exception if script fails - FailOnError: bool - - /// Ignores command line swithes - IgnoreCommandLine: bool +/// Execution status of a single target: built, skipped, or was already a file. +type ExecStatus = | Succeed | Skipped | JustFile - /// Disable logo message - Nologo: bool - - /// Database file - DbFileName: string - - /// Do not execute rules, just display run stats - DryRun: bool - - /// Dump dependencies only - DumpDeps: bool - - /// Dump dependencies only - Progress: bool +/// Engine-level options: immutable after construction. +type EngineOptions = { + ProjectRoot: string + Threads: int + Logger: ILogger + Teardown: string list + Rules: Rules } with -static member Default = - { - ProjectRoot = System.IO.Directory.GetCurrentDirectory() - Threads = System.Environment.ProcessorCount - ConLogLevel = Normal - - CustomLogger = CustomLogger (fun _ -> false) ignore - FileLog = "build.log" - FileLogLevel = Chatty - Targets = [] - FailOnError = false - Vars = List.Empty - IgnoreCommandLine = false - Nologo = false - DbFileName = ".xake" - DryRun = false - DumpDeps = false - Progress = true + static member Default = { + ProjectRoot = System.IO.Directory.GetCurrentDirectory() + Threads = System.Environment.ProcessorCount + Logger = CustomLogger (fun _ -> false) ignore + Teardown = [] + Rules = Rules [] } -end -type internal ExecStatus = | Succeed | Skipped | JustFile -type private TaskPool = Agent> - -/// Script execution context -type ExecContext = { - TaskPool: TaskPool +/// Engine-level immutable state shared across all tasks. +and EngineState = { + Options: EngineOptions Db: Agent - Throttler: SemaphoreSlim - Options: ExecOptions - Rules: Rules - Logger: ILogger + Scheduler: Scheduler RootLogger: ILogger +} + +/// Script execution context +and ExecContext = { + Engine: EngineState + // Build-level + Vars: (string * string) list Progress: Agent + NeedRebuild: Target list -> bool + ShowProgress: bool + // Task-level Targets: Target list RuleMatches: Map Ordinal: int - NeedRebuild: Target list -> bool -} + Logger: ILogger +} with + /// Shortcut to engine options. + member ctx.Options = ctx.Engine.Options + /// Shortcut to the build database agent. + member ctx.Db = ctx.Engine.Db +/// Internal utility functions for reading environment and script variables. module internal Util = let private nullableToOption = function | null -> None | s -> Some s + /// Reads an environment variable, returning None if unset. let getEnvVar = System.Environment.GetEnvironmentVariable >> nullableToOption let private valueByName variableName = function |name,value when name = variableName -> Some value | _ -> None - let getVar (options: ExecOptions) name = options.Vars |> List.tryPick (valueByName name) + /// Looks up a script variable by name from a key-value list. + let getVar (vars: (string * string) list) name = vars |> List.tryPick (valueByName name) + +/// Controls which source(s) a variable resolves from. +type LookupScope = ArgAndEnv | EnvOnly | ArgOnly + +/// Help metadata for --help output. +type VarHelp = { + TypeName: string + EnvVarName: string option + DefaultStr: string option + IsRequired: bool + Description: string option + Scope: LookupScope +} + diff --git a/src/core/File.fs b/src/core/File.fs index 4dd6e0a..99b6ade 100644 --- a/src/core/File.fs +++ b/src/core/File.fs @@ -3,8 +3,8 @@ module private impl = let compareNames : string -> string -> int = - let isUnix = Env.isUnix - fun a b -> System.String.Compare(a, b, isUnix) + let ignoreCase = Env.isUnix + fun a b -> System.String.Compare(a, b, ignoreCase) let getFileHash : string -> int = if Env.isUnix then @@ -55,15 +55,22 @@ module File = type private BclFile = System.IO.File + /// Creates a File from the given path string. Fails if the name is null or whitespace. let make n = if String.IsNullOrWhiteSpace n then failwith "File name cannot be empty" T (n, System.IO.FileInfo n) + /// Returns the file name portion of a File's path. let getFileName (f:File) = f.Name |> Path.GetFileName + /// Returns the file extension including the leading dot. let getFileExt (f:File) = f.Name |> Path.GetExtension + /// Returns the directory portion of a File's full path. let getDirName (f:File) = f.FullName |> Path.GetDirectoryName + /// Returns the fully qualified path of the file. let getFullName (f:File) = f.FullName + /// Returns true if the file exists on disk. let exists (f:File) = BclFile.Exists f.FullName + /// Returns the last write time of the file. let getLastWriteTime (f:File) = BclFile.GetLastWriteTime f.FullName diff --git a/src/core/FileTasksImpl.fs b/src/core/FileTasksImpl.fs index b9b282c..a1a9155 100644 --- a/src/core/FileTasksImpl.fs +++ b/src/core/FileTasksImpl.fs @@ -4,6 +4,7 @@ module internal Xake.FileTasksImpl open System.IO open Xake +/// Ensures the parent directory of the given file path exists, creating it if necessary. let ensureDirCreated fileName = let dir = fileName |> Path.GetDirectoryName diff --git a/src/core/Fileset.fs b/src/core/Fileset.fs index 9d481ba..1e37128 100644 --- a/src/core/Fileset.fs +++ b/src/core/Fileset.fs @@ -1,297 +1,304 @@ -namespace Xake - -[] -module Fileset = - - open System.IO - open Xake - - /// - /// Defines interface to a file system - /// - type FileSystemType = { - GetDisk: string -> string - GetDirRoot: string -> string - GetParent: string -> string - AllDirs: string -> string seq - ScanDirs: string -> string -> string seq // mask -> dir -> dirs - ScanFiles: string -> string -> string seq // mask -> dir -> files +[] +module Xake.Fileset + +open System.IO +open Xake + +/// +/// Defines interface to a file system +/// +type FileSystemType = { + GetDisk: string -> string + GetDirRoot: string -> string + GetParent: string -> string + AllDirs: string -> string seq + ScanDirs: string -> string -> string seq // mask -> dir -> dirs + ScanFiles: string -> string -> string seq // mask -> dir -> files +} + +/// Type alias for a file pattern string. +type FilePattern = string + +/// Filesystem pattern +type FilesetElement = | Includes of Path.PathMask | Excludes of Path.PathMask + +/// Options controlling fileset evaluation: base directory and empty-result behavior. +type FilesetOptions = {FailOnEmpty:bool; BaseDir:string option} + +/// A fileset definition: options plus a list of include/exclude elements. +type Fileset = Fileset of FilesetOptions * FilesetElement list +/// A materialized list of files produced from evaluating a Fileset. +type Filelist = Filelist of File list + +/// Default fileset options +let DefaultOptions = {FilesetOptions.BaseDir = None; FailOnEmpty = false} + +/// The empty fileset with default options. +let Empty = Fileset (DefaultOptions,[]) +/// The empty file list. +let EmptyList = Filelist [] + +/// Implementation module +module private Impl = + + open Path + + let fullname (f:DirectoryInfo) = f.FullName + + let FileSystem = { + GetDisk = fun d -> d + Path.DirectorySeparatorChar.ToString() + GetDirRoot = fun x -> Directory.GetDirectoryRoot x + GetParent = Directory.GetParent >> fullname + AllDirs = fun dir -> Directory.EnumerateDirectories(dir, "*", SearchOption.AllDirectories) + ScanDirs = fun mask dir -> Directory.EnumerateDirectories(dir, mask, SearchOption.TopDirectoryOnly) + ScanFiles = fun mask dir -> Directory.EnumerateFiles(dir, mask) } - type FilePattern = string - - /// Filesystem pattern - type FilesetElement = | Includes of Path.PathMask | Excludes of Path.PathMask - - type FilesetOptions = {FailOnEmpty:bool; BaseDir:string option} - - // Fileset is either set of rules or list of files (materialized) - type Fileset = Fileset of FilesetOptions * FilesetElement list - type Filelist = Filelist of File list - - /// Default fileset options - let DefaultOptions = {FilesetOptions.BaseDir = None; FailOnEmpty = false} - - let Empty = Fileset (DefaultOptions,[]) - let EmptyList = Filelist [] - - /// Implementation module - module private Impl = - - open Path - - let fullname (f:DirectoryInfo) = f.FullName - - let FileSystem = { - GetDisk = fun d -> d + Path.DirectorySeparatorChar.ToString() - GetDirRoot = fun x -> Directory.GetDirectoryRoot x - GetParent = Directory.GetParent >> fullname - AllDirs = fun dir -> Directory.EnumerateDirectories(dir, "*", SearchOption.AllDirectories) - ScanDirs = fun mask dir -> Directory.EnumerateDirectories(dir, mask, SearchOption.TopDirectoryOnly) - ScanFiles = fun mask dir -> Directory.EnumerateFiles(dir, mask) - } - - /// - /// Changes current directory - /// - /// File system implementation - /// Starting path - /// target path - let cd (fs:FileSystemType) startIn (Path.PathMask path) = - // TODO check path exists after each step - let applyPart (path:string) = function - | CurrentDir -> path - | Disk d -> fs.GetDisk d - | FsRoot -> path |> fs.GetDirRoot - | Parent -> path |> fs.GetParent - | Directory d -> Path.Combine(path, d) - | _ -> failwith "ChDir could only contain disk or directory names" - in - (startIn, path) ||> List.fold applyPart - - let listFiles (fs:FileSystemType) startIn (Path.PathMask pat) = - - // The pattern without mask become "explicit" file reference which is always included in resulting file list, regardless file presence. See impl notes for details. - let isExplicitRule = pat |> List.exists (function | DirectoryMask _ | FileMask _ | Recurse -> true | _ -> false) |> not - let filterDir = if isExplicitRule then id else Seq.filter Directory.Exists - let filterFile = if isExplicitRule then id else Seq.filter File.Exists - - // Recursively applies the pattern rules to every item is start list - let applyPart (paths: seq) :_ -> seq = function - | Disk d -> fs.GetDisk d |> Seq.singleton - | FsRoot -> paths |> Seq.map fs.GetDirRoot - | CurrentDir -> paths - | Parent -> paths |> Seq.map fs.GetParent - | Recurse -> paths |> Seq.collect fs.AllDirs |> Seq.append paths - | DirectoryMask mask -> paths |> Seq.collect (fs.ScanDirs mask) - | Directory d -> paths |> Seq.map (fun dir -> Path.Combine(dir, d)) |> filterDir - | FileMask mask -> paths |> Seq.collect (fs.ScanFiles mask) - | FileName f -> paths |> Seq.map (fun dir -> Path.Combine(dir, f)) |> filterFile - in - (startIn, pat) ||> List.fold applyPart - - let ifNone = Option.fold (fun _ -> id) - - /// Implementation of fileset execute - /// "Materializes" fileset to a filelist - let scan fileSystem root (Fileset (options,filesetItems)) = - - let startDirPat = options.BaseDir |> ifNone root |> Path.parseDir - let startDir = startDirPat |> cd fileSystem "." - - // TODO check performance, build function - let includes src = [startDir] |> (listFiles fileSystem) >> Seq.append src - let excludes src pat = - let matchFile = Path.join startDirPat pat |> Path.matchesPattern in - src |> Seq.filter (matchFile >> not) - - let folditem i = function - | Includes pat -> includes i pat - | Excludes pat -> excludes i pat - - filesetItems |> Seq.ofList |> Seq.fold folditem Seq.empty |> Seq.map File.make |> List.ofSeq |> Filelist - - // combines two fileset options - let combineOptions (o1:FilesetOptions) (o2:FilesetOptions) = - {DefaultOptions with - BaseDir = - match o1.BaseDir,o2.BaseDir with - | Some _, Some _ -> failwith "Cannot combine filesets with basedirs defined in both (not implemented)" - | Some _, None -> o1.BaseDir - | _ -> o2.BaseDir - FailOnEmpty = o1.FailOnEmpty || o2.FailOnEmpty} - - // combines two filesets - let combineWith (Fileset (o2, set2)) (Fileset (o1,set1)) = Fileset(combineOptions o1 o2, set1 @ set2) - - // Combines result of reading file to a fileset - let combineWithFile map (file:FileInfo) (Fileset (opts,fs)) = - let elements = File.ReadAllLines file.FullName |> Array.toList |> List.map map in - Fileset (opts, fs @ elements) - // TODO filter comments, empty lines? |> Array.filter - - let changeBasedir dir (Fileset (opts,ps)) = Fileset ({opts with BaseDir = Some dir}, ps) - let changeFailonEmpty f (Fileset (opts,ps)) = Fileset ({opts with FailOnEmpty = f}, ps) - - /// Fileset persistance implementation - module private PicklerImpl = - - open Pickler - - let filesetoptions = - wrap( - (fun(foe,bdir) -> {FilesetOptions.FailOnEmpty = foe; BaseDir = bdir}), - fun o -> (o.FailOnEmpty, o.BaseDir)) - (pair bool (option str)) - - let filesetElement = - alt - (function | Includes _ -> 0 | Excludes _ -> 1) - [| - wrap (Includes, fun (Includes p | OtherwiseFail p) -> p) Path.pickler - wrap (Excludes, fun (Excludes p | OtherwiseFail p) -> p) Path.pickler - |] - - let fileinfo = wrap(File.make, File.getFullName) str - - let fileset = wrap(Fileset, fun (Fileset (o,l)) -> o,l) (pair filesetoptions (list filesetElement)) - let filelist = wrap(Filelist, fun (Filelist l) -> l) (list fileinfo) - - open Impl - - /// Gets the pickler for fileset type - let filesetPickler = PicklerImpl.fileset - let filelistPickler = PicklerImpl.filelist - /// - /// Creates a new fileset with default options. + /// Changes current directory /// - /// - let ls (filePattern:FilePattern) = - // TODO Path.parse is expected to handle trailing slash character - let parse = match filePattern.EndsWith ("/") || filePattern.EndsWith ("\\") with | true -> Path.parseDir | _-> Path.parse - Fileset (DefaultOptions, [filePattern |> parse |> Includes]) - - /// - /// Create a file set for specific file mask. The same as "ls" - /// - let (!!) = ls - - /// - /// Defines the empty fileset with a specified base dir. - /// - /// - let (~+) dir = - Fileset ({DefaultOptions with BaseDir = Some dir}, []) - - [] - let parseFileMask = Path.parse - - [] - let parseDirMask = Path.parseDir - - // let matches filePattern projectRoot - [] - let matches = Path.matches - - let FileSystem = Impl.FileSystem - - /// + /// File system implementation + /// Starting path + /// target path + let cd (fs:FileSystemType) startIn (Path.PathMask path) = + // TODO check path exists after each step + let applyPart (path:string) = function + | CurrentDir -> path + | Disk d -> fs.GetDisk d + | FsRoot -> path |> fs.GetDirRoot + | Parent -> path |> fs.GetParent + | Directory d -> Path.Combine(path, d) + | _ -> failwith "ChDir could only contain disk or directory names" + in + (startIn, path) ||> List.fold applyPart + + let listFiles (fs:FileSystemType) startIn (Path.PathMask pat) = + + // The pattern without mask become "explicit" file reference which is always included in resulting file list, regardless file presence. See impl notes for details. + let isExplicitRule = pat |> List.exists (function | DirectoryMask _ | FileMask _ | Recurse -> true | _ -> false) |> not + let filterDir = if isExplicitRule then id else Seq.filter Directory.Exists + let filterFile = if isExplicitRule then id else Seq.filter File.Exists + + // Recursively applies the pattern rules to every item is start list + let applyPart (paths: seq) :_ -> seq = function + | Disk d -> fs.GetDisk d |> Seq.singleton + | FsRoot -> paths |> Seq.map fs.GetDirRoot + | CurrentDir -> paths + | Parent -> paths |> Seq.map fs.GetParent + | Recurse -> paths |> Seq.collect fs.AllDirs |> Seq.append paths + | DirectoryMask mask -> paths |> Seq.collect (fs.ScanDirs mask) + | Directory d -> paths |> Seq.map (fun dir -> Path.Combine(dir, d)) |> filterDir + | FileMask mask -> paths |> Seq.collect (fs.ScanFiles mask) + | FileName f -> paths |> Seq.map (fun dir -> Path.Combine(dir, f)) |> filterFile + in + (startIn, pat) ||> List.fold applyPart + + let ifNone = Option.fold (fun _ -> id) + + /// Implementation of fileset execute /// "Materializes" fileset to a filelist - /// - let toFileList = Impl.scan Impl.FileSystem - - /// - /// "Materializes" file mask to a list of files/paths - /// - let listByMask (root:string) = Impl.listFiles Impl.FileSystem [root] + let scan fileSystem root (Fileset (options,filesetItems)) = + + let startDirPat = options.BaseDir |> ifNone root |> Path.parseDir + let startDir = startDirPat |> cd fileSystem "." + + // TODO check performance, build function + let includes src = [startDir] |> (listFiles fileSystem) >> Seq.append src + let excludes src pat = + let matchFile = Path.join startDirPat pat |> Path.matchesPattern in + src |> Seq.filter (matchFile >> not) + + let folditem i = function + | Includes pat -> includes i pat + | Excludes pat -> excludes i pat + + filesetItems |> Seq.ofList |> Seq.fold folditem Seq.empty |> Seq.map File.make |> List.ofSeq |> Filelist + + // combines two fileset options + let combineOptions (o1:FilesetOptions) (o2:FilesetOptions) = + {DefaultOptions with + BaseDir = + match o1.BaseDir,o2.BaseDir with + | Some _, Some _ -> failwith "Cannot combine filesets with basedirs defined in both (not implemented)" + | Some _, None -> o1.BaseDir + | _ -> o2.BaseDir + FailOnEmpty = o1.FailOnEmpty || o2.FailOnEmpty} + + // combines two filesets + let combineWith (Fileset (o2, set2)) (Fileset (o1,set1)) = Fileset(combineOptions o1 o2, set1 @ set2) + + // Combines result of reading file to a fileset + let combineWithFile map (file:FileInfo) (Fileset (opts,fs)) = + let elements = File.ReadAllLines file.FullName |> Array.toList |> List.map map in + Fileset (opts, fs @ elements) + // TODO filter comments, empty lines? |> Array.filter + + let changeBasedir dir (Fileset (opts,ps)) = Fileset ({opts with BaseDir = Some dir}, ps) + let changeFailonEmpty f (Fileset (opts,ps)) = Fileset ({opts with FailOnEmpty = f}, ps) + +/// Fileset persistance implementation +module private PicklerImpl = + + open Pickler + + let filesetoptions = + wrap( + (fun(foe,bdir) -> {FilesetOptions.FailOnEmpty = foe; BaseDir = bdir}), + fun o -> (o.FailOnEmpty, o.BaseDir)) + (pair bool (option str)) + + let filesetElement = + alt + (function | Includes _ -> 0 | Excludes _ -> 1) + [| + wrap (Includes, fun (Includes p | OtherwiseFail p) -> p) Path.pickler + wrap (Excludes, fun (Excludes p | OtherwiseFail p) -> p) Path.pickler + |] + + let fileinfo = wrap(File.make, File.getFullName) str + + let fileset = wrap(Fileset, fun (Fileset (o,l)) -> o,l) (pair filesetoptions (list filesetElement)) + let filelist = wrap(Filelist, fun (Filelist l) -> l) (list fileinfo) + +open Impl + +/// Gets the pickler for fileset type +let filesetPickler = PicklerImpl.fileset +/// Gets the pickler for filelist type +let filelistPickler = PicklerImpl.filelist + +/// +/// Creates a new fileset with default options. +/// +/// +let ls (filePattern:FilePattern) = + // TODO Path.parse is expected to handle trailing slash character + let parse = match filePattern.EndsWith ("/") || filePattern.EndsWith ("\\") with | true -> Path.parseDir | _-> Path.parse + Fileset (DefaultOptions, [filePattern |> parse |> Includes]) + +/// +/// Create a file set for specific file mask. The same as "ls" +/// +let (!!) = ls + +/// +/// Defines the empty fileset with a specified base dir. +/// +/// +let (~+) dir = + Fileset ({DefaultOptions with BaseDir = Some dir}, []) + +[] +let parseFileMask = Path.parse + +[] +let parseDirMask = Path.parseDir + +// let matches filePattern projectRoot +[] +let matches = Path.matches + +/// The real file system adapter used by default. +let FileSystem = Impl.FileSystem + +/// +/// "Materializes" fileset to a filelist +/// +let toFileList = Impl.scan Impl.FileSystem + +/// +/// "Materializes" file mask to a list of files/paths +/// +let listByMask (root:string) = Impl.listFiles Impl.FileSystem [root] + +/// +/// The same as toFileList but allows to provide file system adapter +/// +let toFileList1 = Impl.scan + +/// Describes how a file list changed: an item was added or removed. +type ListDiffType<'a> = | Added of 'a | Removed of 'a + +/// +/// Compares two file lists and returns differences list. +/// +/// +/// +let compareFileList (Filelist list1) (Filelist list2) = - /// - /// The same as toFileList but allows to provide file system adapter - /// - let toFileList1 = Impl.scan + let setOfNames = List.map File.getFullName >> Set.ofList - type ListDiffType<'a> = | Added of 'a | Removed of 'a + let set1, set2 = setOfNames list1, setOfNames list2 - /// - /// Compares two file lists and returns differences list. - /// - /// - /// - let compareFileList (Filelist list1) (Filelist list2) = - - let setOfNames = List.map File.getFullName >> Set.ofList - - let set1, set2 = setOfNames list1, setOfNames list2 + let removed = Set.difference set1 set2 |> List.ofSeq |> List.map (Removed) + let added = Set.difference set2 set1 |> List.ofSeq |> List.map (Added) - let removed = Set.difference set1 set2 |> List.ofSeq |> List.map (Removed) - let added = Set.difference set2 set1 |> List.ofSeq |> List.map (Added) + removed @ added - removed @ added - - /// - /// Defines various operations on Fieset type. - /// - type Fileset with - static member (+) (fs1, fs2: Fileset) :Fileset = fs1 |> combineWith fs2 - static member (+) (fs1: Fileset, pat) = fs1 ++ pat - static member (-) (fs1: Fileset, pat) = fs1 -- pat - static member (@@) (fs1, basedir) = fs1 |> Impl.changeBasedir basedir - static member (@@) (Fileset (_,lst), options) = Fileset (options,lst) +/// +/// Defines various operations on Fieset type. +/// +type Fileset with + static member (+) (fs1, fs2: Fileset) :Fileset = fs1 |> combineWith fs2 + static member (+) (fs1: Fileset, pat) = fs1 ++ pat + static member (-) (fs1: Fileset, pat) = fs1 -- pat + static member (@@) (fs1, basedir) = fs1 |> Impl.changeBasedir basedir + static member (@@) (Fileset (_,lst), options) = Fileset (options,lst) - /// Conditional include/exclude operator - static member (+?) (fs1: Fileset, (condition:bool,pat: FilePattern)) = if condition then fs1 ++ pat else fs1 - static member (+?) (fs1: Fileset, (condition:bool,fs2: Fileset)) :Fileset = if condition then fs1 |> combineWith fs2 else fs1 - static member (-?) (fs1: Fileset, (condition:bool,pat: FilePattern)) = if condition then fs1 -- pat else fs1 + /// Conditional include/exclude operator + static member (+?) (fs1: Fileset, (condition:bool,pat: FilePattern)) = if condition then fs1 ++ pat else fs1 + static member (+?) (fs1: Fileset, (condition:bool,fs2: Fileset)) :Fileset = if condition then fs1 |> combineWith fs2 else fs1 + static member (-?) (fs1: Fileset, (condition:bool,pat: FilePattern)) = if condition then fs1 -- pat else fs1 - /// Adds includes pattern to a fileset. - static member (++) ((Fileset (opts,pts)), includes) :Fileset = - Fileset (opts, pts @ [includes |> Path.parse |> Includes]) + /// Adds includes pattern to a fileset. + static member (++) ((Fileset (opts,pts)), includes) :Fileset = + Fileset (opts, pts @ [includes |> Path.parse |> Includes]) - /// Adds excludes pattern to a fileset. - static member (--) (Fileset (opts,pts), excludes) = - Fileset (opts, pts @ [excludes |> Path.parse |> Excludes]) - end + /// Adds excludes pattern to a fileset. + static member (--) (Fileset (opts,pts), excludes): Fileset = + Fileset (opts, pts @ [excludes |> Path.parse |> Excludes]) +end - (******** builder ********) - type FilesetBuilder() = +/// Computation expression builder for constructing Fileset values. +type FilesetBuilder() = - [] - member __.FailOnEmpty(fs,f) = fs |> changeFailonEmpty f + [] + member __.FailOnEmpty(fs,f) = fs |> changeFailonEmpty f - [] - member __.Basedir(fs,dir) = fs |> changeBasedir dir + [] + member __.Basedir(fs,dir) = fs |> changeBasedir dir - [] - member __.Includes(fs:Fileset,pattern) = fs ++ pattern + [] + member __.Includes(fs:Fileset,pattern) = fs ++ pattern - [] - member __.IncludesIf(fs:Fileset,condition, pattern:FilePattern) = fs +? (condition,pattern) + [] + member __.IncludesIf(fs:Fileset,condition, pattern:FilePattern) = fs +? (condition,pattern) - [] - member __.JoinFileset(fs1, fs2) = fs1 |> Impl.combineWith fs2 + [] + member __.JoinFileset(fs1, fs2) = fs1 |> Impl.combineWith fs2 - [] - member __.Excludes(fs:Fileset, pattern) = fs -- pattern + [] + member __.Excludes(fs:Fileset, pattern) = fs -- pattern - [] - member __.ExcludesIf(fs:Fileset, pattern) = fs -? pattern + [] + member __.ExcludesIf(fs:Fileset, pattern) = fs -? pattern - [] - member __.IncludeFile(fs, file) = (fs,file) ||> combineWithFile (Path.parse >> Includes) + [] + member __.IncludeFile(fs, file) = (fs,file) ||> combineWithFile (Path.parse >> Includes) - [] - member __.ExcludeFile(fs,file) = (fs,file) ||> combineWithFile (Path.parse >> Excludes) + [] + member __.ExcludeFile(fs,file) = (fs,file) ||> combineWithFile (Path.parse >> Excludes) - member __.Yield(()) = Empty - member __.Return(pattern:FilePattern) = Empty ++ pattern + member __.Yield(()) = Empty + member __.Return(pattern:FilePattern) = Empty ++ pattern - member __.Combine(fs1, fs2) = fs1 |> Impl.combineWith fs2 - member __.Delay(f) = f() - member this.Zero() = this.Yield ( () ) + member __.Combine(fs1, fs2) = fs1 |> Impl.combineWith fs2 + member __.Delay(f) = f() + member this.Zero() = this.Yield ( () ) - member __.Bind(fs1:Fileset, f) = let fs2 = f() in fs1 |> Impl.combineWith fs2 - member x.For(fs, f) = x.Bind(fs, f) - member x.Return(a) = x.Yield(a) + member __.Bind(fs1:Fileset, f) = let fs2 = f() in fs1 |> Impl.combineWith fs2 + member x.For(fs, f) = x.Bind(fs, f) + member x.Return(a) = x.Yield(a) - let fileset = FilesetBuilder() +/// The fileset computation expression builder instance. +let fileset = FilesetBuilder() diff --git a/src/core/Logging.fs b/src/core/Logging.fs index a8124df..92dedca 100644 --- a/src/core/Logging.fs +++ b/src/core/Logging.fs @@ -25,7 +25,8 @@ type Verbosity = | Chatty | Diag -let LevelToString = +/// Converts a log level to its short display string. +let LevelToString = function | Message -> "MSG" | Error -> "ERROR" @@ -101,7 +102,19 @@ module private ConsoleSink = // Going to render progress bar this way: // | 22% [MM------------------] 0m 12s left let ProgressBarLen = 20 - type Message = | Message of Level * string | Progress of int * System.TimeSpan | Flush of AsyncReplyChannel + + type RenderCommand = + | WriteLine of Level * string + | SetStatus of string option + | Flush of AsyncReplyChannel + + type RenderState = { + StatusBarText: string option // raw bar text without spinner, for dedup + StatusText: string option // full rendered text with spinner, for display/clear + StatusVisible: bool + Interactive: bool + SpinnerTick: int + } let levelToColor = function | Level.Message -> Some (ConsoleColor.White, ConsoleColor.White) @@ -114,80 +127,102 @@ module private ConsoleSink = | _ -> None let fmtTs (ts:System.TimeSpan) = - (if ts.TotalHours >= 1.0 then "h'h'\ mm'm'\ ss's'" - else if ts.TotalMinutes >= 1.0 then "mm'm'\ ss's'" - else "'0m 'ss's'") - |> ts.ToString + if ts.TotalHours >= 1.0 then sprintf "%dh %02dm" (int ts.TotalHours) ts.Minutes + else if ts.TotalMinutes >= 1.0 then sprintf "%dm %02ds" (int ts.TotalMinutes) ts.Seconds + else sprintf "%ds" ts.Seconds + + let isInteractiveConsole = + not Console.IsOutputRedirected && not Console.IsErrorRedirected + + let spinnerFrames = [|"⠋";"⠙";"⠹";"⠸";"⠼";"⠴";"⠦";"⠧";"⠇";"⠏"|] + + let formatStatus (timeLeft:System.TimeSpan, pct, activeTasks) = + match pct with + | a when a >= 100 || a < 0 || timeLeft.TotalMilliseconds < 100.0 -> None + | _ -> + let partialChars = [|""; "▏"; "▎"; "▍"; "▌"; "▋"; "▊"; "▉"|] + let filledSubunits = pct * ProgressBarLen * 8 / 100 + let fullBlocks = filledSubunits / 8 + let partial = filledSubunits % 8 + let emptyLen = ProgressBarLen - fullBlocks - (if partial > 0 then 1 else 0) + let bar = sprintf "%s%s%s" (String.replicate fullBlocks "█") partialChars.[partial] (String.replicate emptyLen " ") // '░' + let taskStr = if activeTasks = 1 then "1 task" else sprintf "%d tasks" activeTasks + Some <| sprintf "%3d%% [%s] %s · %s left" pct bar taskStr (fmtTs timeLeft) let po = MailboxProcessor.Start(fun mbox -> - let rec loop (progressMessage) = - let wipeProgressMessage () = - let len = progressMessage |> Option.fold (fun _ -> String.length) 0 - // printfn "cleft: %A len: %d" Console.CursorLeft len - match len - Console.CursorLeft with - | e when e > 0 -> System.Console.Write (String.replicate e " ") - | _ -> () - let renderProgress = function - | Some (outputString: string) -> - Console.ForegroundColor <- ConsoleColor.White - Console.Write outputString - wipeProgressMessage() + let rec loop state = + // Writes \r + spaces + \r to fully erase current status bar, cursor returns to col 0 + let eraseStatus () = + let len = state.StatusText |> Option.fold (fun _ -> String.length) 0 + Console.Write ("\r" + String.replicate len " " + "\r") + let drawStatus statusText = + match state.Interactive, statusText with + | true, Some outputString -> + Console.ForegroundColor <- ConsoleColor.White + Console.Write (outputString: string) // caller already at col 0 after eraseStatus Console.ResetColor() - | None -> () + | _ -> () + let renderLineWithInfo (color, textColor) level (txt: string) = + // caller has already erased the status bar so cursor is at col 0 Console.ForegroundColor <- color - Console.Write (sprintf "\r[%s] " level) - + Console.Write (sprintf "[%s] " level) Console.ForegroundColor <- textColor - System.Console.Write txt - wipeProgressMessage() - System.Console.WriteLine() + Console.Write txt + // pad any remaining status bar width so old chars don't bleed through + let statusLen = state.StatusText |> Option.fold (fun _ -> String.length) 0 + let writtenLen = level.Length + 3 + txt.Length // "[level] " = level+3 + let pad = statusLen - writtenLen + if pad > 0 then Console.Write (String.replicate pad " ") + Console.WriteLine() + + let writeLines level (text: string) = + match level |> levelToColor with + | Some colors -> + text.Split '\n' + |> Seq.iteri (fun index (part: string) -> + let line = part.TrimEnd '\r' + match index with + | 0 -> renderLineWithInfo colors (LevelToString level) line + | _ -> Console.WriteLine line) + | _ -> () + Console.ResetColor() - async { + async { let! msg = mbox.Receive() match msg with - | Message(level, text) -> - match level |> levelToColor with - | Some colors -> - // in case of CRLF in the string make sure we washed out the progress message - let rec writeLines = function - | [] -> fun _ -> () - | (txt: string)::tail -> - function - | true -> - renderLineWithInfo colors (LevelToString level) txt - do writeLines tail false - | false -> System.Console.WriteLine txt; do writeLines tail false - - writeLines (text.Split('\n') |> List.ofArray) true - renderProgress progressMessage - - | _ -> () - Console.ResetColor() - - | Progress (pct, timeLeft) -> - let outputString = - match pct with - | a when a >= 100 || a < 0 || timeLeft.TotalMilliseconds < 100.0 -> "" - | pct -> - let barlen = pct * ProgressBarLen / 100 - sprintf "\r%3d%% Complete [%s%s] %s Left" pct (String.replicate barlen "=") (String.replicate (ProgressBarLen - barlen) " ") (fmtTs timeLeft) - |> Some - - renderProgress outputString - return! loop outputString + | WriteLine(level, text) -> + if state.StatusVisible then eraseStatus() + writeLines level text + if state.StatusVisible then drawStatus state.StatusText + return! loop state + + | SetStatus barText -> + let nextState = + match state.Interactive with + | false -> { state with StatusBarText = barText; StatusText = barText; StatusVisible = false } + | true -> + if barText = state.StatusBarText then + state + else + if state.StatusVisible then eraseStatus() + let newTick = (state.SpinnerTick + 1) % spinnerFrames.Length + let fullText = barText |> Option.map (fun bt -> sprintf "%s %s" spinnerFrames.[newTick] bt) + let visible = fullText.IsSome + if visible then drawStatus fullText + { state with StatusBarText = barText; StatusText = fullText; StatusVisible = visible; SpinnerTick = newTick } + return! loop nextState | Flush ch -> - wipeProgressMessage() - Console.Write "\r" + if state.StatusVisible then eraseStatus() + do! Console.Out.FlushAsync() |> Async.AwaitTask ch.Reply () - return! loop None - - return! loop progressMessage + return! loop { state with StatusVisible = false } } - loop None) + + loop { StatusBarText = None; StatusText = None; StatusVisible = false; Interactive = isInteractiveConsole; SpinnerTick = 0 }) /// @@ -206,24 +241,25 @@ let private ConsoleLoggerBase (write: Level -> string -> unit) maxLevel = /// Simplistic console logger. let DumbConsoleLogger = - ConsoleLoggerBase ( - fun level -> (LevelToString level) |> sprintf "[%s] %s" >> System.Console.WriteLine - ) + ConsoleLoggerBase (fun l -> l |> LevelToString |> sprintf "[%s] %s" >> System.Console.WriteLine) /// Console logger with colors highlighting let ConsoleLogger = - ConsoleLoggerBase (fun level s -> ConsoleSink.Message(level,s) |> ConsoleSink.po.Post) + ConsoleLoggerBase (fun level s -> ConsoleSink.WriteLine(level,s) |> ConsoleSink.po.Post) /// Ensures all logs finished pending output. let FlushLogs () = try - ConsoleSink.po.PostAndReply (ConsoleSink.Flush, 200) |> ignore + ConsoleSink.po.PostAndTryAsyncReply (ConsoleSink.Flush, 200) |> Async.RunSynchronously |> ignore with _ -> () /// Draws a progress bar to console log. let WriteConsoleProgress = - let swap (a,b) = (b,a) in - swap >> ConsoleSink.Progress >> ConsoleSink.po.Post + fun progressData -> + progressData + |> ConsoleSink.formatStatus + |> ConsoleSink.SetStatus + |> ConsoleSink.po.Post /// /// Creates a logger that is combination of two loggers. @@ -233,9 +269,7 @@ let WriteConsoleProgress = let CombineLogger (log1 : ILogger) (log2 : ILogger) = { new ILogger with member __.Log level (fmt : Printf.StringFormat<'a, unit>) : 'a = - let write s = - log1.Log level "%s" s - log2.Log level "%s" s + let write s = log1.Log level "%s" s; log2.Log level "%s" s Printf.kprintf write fmt } /// @@ -254,11 +288,11 @@ let PrefixLogger (prefix:string) (log : ILogger) = /// /// let parseVerbosity = function - | "Silent" -> Verbosity.Silent - | "Quiet" -> Verbosity.Quiet - | "Normal" -> Verbosity.Normal - | "Loud" -> Verbosity.Loud - | "Chatty" -> Verbosity.Chatty - | "Diag" -> Verbosity.Diag + | "Silent" -> Silent + | "Quiet" -> Quiet + | "Normal" -> Normal + | "Loud" -> Loud + | "Chatty" -> Chatty + | "Diag" -> Diag | s -> failwithf "invalid verbosity: %s. Expected one of %s" s "Silent | Quiet | Normal | Loud | Chatty | Diag" diff --git a/src/core/Path.fs b/src/core/Path.fs index f85ef95..b5d499c 100644 --- a/src/core/Path.fs +++ b/src/core/Path.fs @@ -1,258 +1,245 @@ -namespace Xake +module Xake.Path open System.IO open System.Text.RegularExpressions -module Path = - - type Part = - | FsRoot - | Parent - | CurrentDir - | Disk of string - | DirectoryMask of string - | Directory of string - | Recurse - | FileMask of string - | FileName of string - - type PathMask = PathMask of Part list - - type MatchResult = - | Matches of (string*string) list - | Nope - - module private impl = - - let notNullOrEmpty = System.String.IsNullOrEmpty >> not - - let driveRegex = Regex(@"^[A-Za-z]:$", RegexOptions.Compiled) - let isMask (a:string) = a.IndexOfAny([|'*';'?'|]) >= 0 - let iif fn b c a = match fn a with | true -> b a | _ -> c a - - let isRoot = function | FsRoot::_ | Disk _::_ -> true | _ -> false - - /// - /// Normalizes the pattern by resolving parent references and removing \.\ - /// - let rec normalize = function - | [] -> [] - | [x] -> [x] - | x::tail -> - match x::(normalize tail) with - | Directory _::Parent::t -> t - | CurrentDir::t -> t - | rest -> rest - - /// - /// Maps part of file path to a path part. - /// - /// - let mapPart isLast = function - | "**" -> Recurse - | "." -> CurrentDir - | ".." -> Parent (* works well now with Path.Combine() *) - | a when a.EndsWith(":") && driveRegex.IsMatch(a) -> Disk(a) - | a when not isLast -> a |> iif isMask DirectoryMask Directory - | a -> a |> iif isMask FileMask FileName - - let parse isLastPart pattern = - - if notNullOrEmpty pattern then - let parts = pattern.Split([|'\\'; '/'|], System.StringSplitOptions.RemoveEmptyEntries) - let fsroot = pattern.[0] |> function | '\\' | '/' -> [FsRoot] | _ -> [] - in - let isLast = isLastPart parts - fsroot @ (parts |> Array.mapi (isLast >> mapPart) |> List.ofArray) - |> normalize |> PathMask - else - PathMask [] - - /// - /// supplementary function for parsing directory - /// - let isLastPartForDir _ _ = false - /// - /// supplementary function for parsing file - /// - let isLastPartForFile (parts:_ array) = (=) (parts.Length-1) - - let dirSeparator = string Path.DirectorySeparatorChar - let partToString = - function - | Directory s - | FileName s - | DirectoryMask s - | FileMask s - -> s - | Parent -> ".." - | Part.CurrentDir -> "." - | Part.Disk d -> d + dirSeparator - | Part.Recurse -> "**" - | Part.FsRoot -> dirSeparator - - - module private PicklerImpl = - - open Pickler - - let patternpart= - alt(function - | FsRoot -> 0 - | Parent -> 1 - | Disk _ -> 2 - | DirectoryMask _ -> 3 - | Directory _ -> 4 - | Recurse -> 5 - | FileMask _ -> 6 - | FileName _ -> 7 - | CurrentDir -> 8 - ) - [| - wrap0 FsRoot - wrap0 Parent - wrap (Disk, fun (Disk d | OtherwiseFail d) -> d) str - wrap (DirectoryMask, fun (DirectoryMask d | OtherwiseFail d) -> d) str - wrap (Directory, fun (Directory d | OtherwiseFail d) -> d) str - wrap0 Recurse - wrap (FileMask, fun (FileMask m | OtherwiseFail m) -> m) str - wrap (FileName, fun (FileName m | OtherwiseFail m) -> m) str - wrap0 CurrentDir - |] - - let pattern = wrap(PathMask, fun(PathMask pp) -> pp) (list patternpart) - - module internal matchImpl = - - let eq s1 s2 = System.StringComparer.OrdinalIgnoreCase.Equals(s1, s2) - - let wildcard2regexMap = - ["**", "(.*)" - "*", """([^/\\]*)""" - "?", "([^/\\\\])" - ".", "\\."; "$", "\\$"; "^", "\\^"; "[", "\\["; "]", "\\]" - "+", "\\+"; "!", "\\!"; "=", "\\="; "{", "\\{"; "}", "\\}" - ] |> dict - - let wildcardToRegex (m:Match) = - match m.Groups.Item("tag") with - | t when not t.Success -> - match wildcard2regexMap.TryGetValue(m.Value) with - | true, v -> v - | _ -> m.Value - | t -> "(?<" + t.Value + ">" - - let normalizeSlashes (pat: string) = - pat.Replace('\\', '/') - - let maskToRegex (pattern:string) = - let pat = Regex.Replace(pattern |> normalizeSlashes, @"\((?'tag'\w+?)\:|\*\*|([*.?$^+!={}])", wildcardToRegex) - // TODO mask with sq brackets - let ignoreCase = if Env.isUnix then RegexOptions.None else RegexOptions.IgnoreCase - in - Regex(@"^" + pat + "$", RegexOptions.Compiled + ignoreCase) - - let matchPart (mask:Part) (path:Part) = - let matchByMask (rx:Regex) value = rx.Match(value).Success - match mask,path with - | (FsRoot, FsRoot) -> true - | (Disk mask, Disk d) | (Directory mask, Directory d) | FileName mask, FileName d when eq mask d -> true +/// A single segment of a parsed file path or pattern. +type Part = + | FsRoot + | Parent + | CurrentDir + | Disk of string + | DirectoryMask of string + | Directory of string + | Recurse + | FileMask of string + | FileName of string - | DirectoryMask mask, Directory d | FileMask mask, FileName d -> - matchByMask (maskToRegex mask) d +/// A parsed Ant-style path pattern consisting of part segments. +type PathMask = PathMask of Part list - | _ -> false +/// Result of matching a file path against a pattern. +type MatchResult = + | Matches of (string*string) list + | Nope - let rec matchPaths (mask:Part list) (p:Part list) = - match mask,p with - | [], [] -> true - | [], _ | _, [] -> false +module private impl = - | Directory _::Recurse::Parent::ms, _ -> matchPaths (Recurse::ms) p - | Recurse::Parent::ms, _ -> matchPaths (Recurse::ms) p // ignore parent ref + let notNullOrEmpty = System.String.IsNullOrEmpty >> not - | Recurse::ms, (FileName _)::_ -> matchPaths ms p - | Recurse::ms, Directory _::xs -> (matchPaths mask xs) || (matchPaths ms p) - | m::ms, x::xs -> - matchPart m x && matchPaths ms xs - - // API - let pickler = PicklerImpl.pattern + let driveRegex = Regex(@"^[A-Za-z]:$", RegexOptions.Compiled) + let isMask (a:string) = a.IndexOfAny([|'*';'?'|]) >= 0 + let iif fn b c a = match fn a with | true -> b a | _ -> c a + + let isRoot = function | FsRoot::_ | Disk _::_ -> true | _ -> false /// - /// Converts path to string representation (platform specific). + /// Normalizes the pattern by resolving parent references and removing \.\ /// - let toString = - List.map impl.partToString - >> List.fold (fun s ps -> Path.Combine (s, ps)) "" + let rec normalize = function + | [] -> [] + | [x] -> [x] + | x::tail -> + match x::(normalize tail) with + | Directory _::Parent::t -> t + | CurrentDir::t -> t + | rest -> rest /// - /// Joins two patterns. + /// Maps part of file path to a path part. /// - /// - /// - let join (PathMask p1) (PathMask p2) = - match impl.isRoot p2 with - | true -> PathMask p2 - | _ -> p1 @ p2 |> impl.normalize |> PathMask + /// + let mapPart isLast = function + | "**" -> Recurse + | "." -> CurrentDir + | ".." -> Parent (* works well now with Path.Combine() *) + | a when a.EndsWith(":") && driveRegex.IsMatch(a) -> Disk(a) + | a when not isLast -> a |> iif isMask DirectoryMask Directory + | a -> a |> iif isMask FileMask FileName + + let parse isLastPart pattern = + + if notNullOrEmpty pattern then + let parts = pattern.Split([|'\\'; '/'|], System.StringSplitOptions.RemoveEmptyEntries) + let fsroot = pattern.[0] |> function | '\\' | '/' -> [FsRoot] | _ -> [] + in + let isLast = isLastPart parts + fsroot @ (parts |> Array.mapi (isLast >> mapPart) |> List.ofArray) + |> normalize |> PathMask + else + PathMask [] /// - /// Converts Ant-style file pattern to a list of parts. Assumes the path specified + /// supplementary function for parsing directory /// - let parseDir = impl.parse impl.isLastPartForDir - + let isLastPartForDir _ _ = false /// - /// Converts Ant-style file pattern to a PathMask. + /// supplementary function for parsing file /// - let parse = impl.parse impl.isLastPartForFile + let isLastPartForFile (parts:_ array) = (=) (parts.Length-1) + + let dirSeparator = string Path.DirectorySeparatorChar + let partToString = + function + | Directory s + | FileName s + | DirectoryMask s + | FileMask s + -> s + | Parent -> ".." + | Part.CurrentDir -> "." + | Part.Disk d -> d + dirSeparator + | Part.Recurse -> "**" + | Part.FsRoot -> dirSeparator + + +module private PicklerImpl = + + open Pickler + + let patternpart= + alt(function + | FsRoot -> 0 + | Parent -> 1 + | Disk _ -> 2 + | DirectoryMask _ -> 3 + | Directory _ -> 4 + | Recurse -> 5 + | FileMask _ -> 6 + | FileName _ -> 7 + | CurrentDir -> 8 + ) + [| + wrap0 FsRoot + wrap0 Parent + wrap (Disk, fun (Disk d | OtherwiseFail d) -> d) str + wrap (DirectoryMask, fun (DirectoryMask d | OtherwiseFail d) -> d) str + wrap (Directory, fun (Directory d | OtherwiseFail d) -> d) str + wrap0 Recurse + wrap (FileMask, fun (FileMask m | OtherwiseFail m) -> m) str + wrap (FileName, fun (FileName m | OtherwiseFail m) -> m) str + wrap0 CurrentDir + |] + + let pattern = wrap(PathMask, fun(PathMask pp) -> pp) (list patternpart) + +module internal matchImpl = + + let eq s1 s2 = System.StringComparer.OrdinalIgnoreCase.Equals(s1, s2) + + let wildcard2regexMap = + ["**", "(.*)" + "*", """([^/\\]*)""" + "?", "([^/\\\\])" + ".", "\\."; "$", "\\$"; "^", "\\^"; "[", "\\["; "]", "\\]" + "+", "\\+"; "!", "\\!"; "=", "\\="; "{", "\\{"; "}", "\\}" + ] |> dict + + let wildcardToRegex (m:Match) = + match m.Groups.Item("tag") with + | t when not t.Success -> + match wildcard2regexMap.TryGetValue(m.Value) with + | true, v -> v + | _ -> m.Value + | t -> "(?<" + t.Value + ">" + + let normalizeSlashes (pat: string) = + pat.Replace('\\', '/') + + let maskToRegex (pattern:string) = + let pat = Regex.Replace(pattern |> normalizeSlashes, @"\((?'tag'\w+?)\:|\*\*|([*.?$^+!={}])", wildcardToRegex) + // TODO mask with sq brackets + let ignoreCase = if Env.isUnix then RegexOptions.None else RegexOptions.IgnoreCase + in + Regex(@"^" + pat + "$", RegexOptions.Compiled + ignoreCase) + + let matchPart (mask:Part) (path:Part) = + let matchByMask (rx:Regex) value = rx.Match(value).Success + match mask,path with + | (FsRoot, FsRoot) -> true + | (Disk mask, Disk d) | (Directory mask, Directory d) | FileName mask, FileName d when eq mask d -> true + + | DirectoryMask mask, Directory d | FileMask mask, FileName d -> + matchByMask (maskToRegex mask) d + + | _ -> false + + let rec matchPaths (mask:Part list) (p:Part list) = + match mask,p with + | [], [] -> true + | [], _ | _, [] -> false + + | Directory _::Recurse::Parent::ms, _ -> matchPaths (Recurse::ms) p + | Recurse::Parent::ms, _ -> matchPaths (Recurse::ms) p // ignore parent ref + + | Recurse::ms, (FileName _)::_ -> matchPaths ms p + | Recurse::ms, Directory _::xs -> (matchPaths mask xs) || (matchPaths ms p) + | m::ms, x::xs -> + matchPart m x && matchPaths ms xs + +/// Pickler for PathMask serialization. +let pickler = PicklerImpl.pattern + +/// +/// Converts path to string representation (platform specific). +/// +let toString = + List.map impl.partToString + >> List.fold (fun s ps -> Path.Combine (s, ps)) "" + +/// +/// Joins two patterns. +/// +/// +/// +let join (PathMask p1) (PathMask p2) = + match impl.isRoot p2 with + | true -> PathMask p2 + | _ -> p1 @ p2 |> impl.normalize |> PathMask + +/// +/// Converts Ant-style file pattern to a list of parts. Assumes the path specified +/// +let parseDir = impl.parse impl.isLastPartForDir + +/// +/// Converts Ant-style file pattern to a PathMask. +/// +let parse = impl.parse impl.isLastPartForFile (* - /// - /// Returns true if a file name (parsed to p) matches specific file mask. - /// - /// - /// - let matchesPattern (pattern:string) = - - let regex = matchImpl.maskToRegex pattern - fun file -> regex.Match(matchImpl.normalizeSlashes file).Success +/// +/// Returns true if a file name (parsed to p) matches specific file mask. +/// +/// +/// +let matchesPattern (pattern:string) = + + let regex = matchImpl.maskToRegex pattern + fun file -> regex.Match(matchImpl.normalizeSlashes file).Success *) - let matchesPattern (PathMask mask) file = - let (PathMask fileParts) = file |> impl.parse impl.isLastPartForFile in - matchImpl.matchPaths mask fileParts - - let matches filePattern rootPath = - // IDEA: make relative path then match to pattern? - // matches "src/**/*.cs" "c:\!\src\a\b\c.cs" -> true - - matchesPattern <| join (parseDir rootPath) (parse filePattern) - - /// file name match implementation for rules - let matchGroups (pattern:string) rootPath = - - let regex = Path.Combine(rootPath, pattern) |> matchImpl.maskToRegex - fun file -> - let m = regex.Match(matchImpl.normalizeSlashes file) - if m.Success then - [for groupName in regex.GetGroupNames() do - let group = m.Groups.[groupName] - yield groupName, group.Value] |> Some - else - None - -[] -module PathExt = - /// - /// Changes or appends file extension. - /// - let (-.) path ext = Path.ChangeExtension(path, ext) +/// Returns true if the parsed file path matches the given PathMask. +let matchesPattern (PathMask mask) file = + let (PathMask fileParts) = file |> impl.parse impl.isLastPartForFile in + matchImpl.matchPaths mask fileParts + +/// Returns true if the file matches the Ant-style pattern relative to the given root. +let matches filePattern rootPath = + // IDEA: make relative path then match to pattern? + // matches "src/**/*.cs" "c:\!\src\a\b\c.cs" -> true + + matchesPattern <| join (parseDir rootPath) (parse filePattern) + +/// Matches a file against a pattern and returns captured named groups, or None if no match. +let matchGroups (pattern:string) rootPath = + + let regex = Path.Combine(rootPath, pattern) |> matchImpl.maskToRegex + fun file -> + let m = regex.Match(matchImpl.normalizeSlashes file) + if m.Success then + [for groupName in regex.GetGroupNames() do + let group = m.Groups.[groupName] + yield groupName, group.Value] |> Some + else + None - /// - /// Combines two paths. - /// - let () path1 path2 = Path.Combine(path1, path2) - - /// - /// Appends the file extension. - /// - let (<.>) path ext = if System.String.IsNullOrWhiteSpace(ext) then path else path + "." + ext diff --git a/src/core/PathExt.fs b/src/core/PathExt.fs new file mode 100644 index 0000000..62d64e6 --- /dev/null +++ b/src/core/PathExt.fs @@ -0,0 +1,19 @@ +[] +module Xake.PathExt + +open System.IO + +/// +/// Changes or appends file extension. +/// +let (-.) path ext = Path.ChangeExtension(path, ext) + +/// +/// Combines two paths. +/// +let () path1 path2 = Path.Combine(path1, path2) + +/// +/// Appends the file extension. +/// +let (<.>) path ext = if System.String.IsNullOrWhiteSpace(ext) then path else path + "." + ext diff --git a/src/core/Pickler.fs b/src/core/Pickler.fs index c6560d8..092c33b 100644 --- a/src/core/Pickler.fs +++ b/src/core/Pickler.fs @@ -1,91 +1,89 @@ -namespace Xake +module Xake.Pickler open System /// Pickler Combinators implementation -module Pickler = +type OutState = IO.BinaryWriter +type InState = IO.BinaryReader - type OutState = System.IO.BinaryWriter - type InState = System.IO.BinaryReader +/// +/// Main pickler type. +/// +type 'a PU = { pickle: 'a -> OutState -> unit; unpickle: InState -> 'a } - /// - /// Main pickler type. - /// - type 'a PU = { pickle: 'a -> OutState -> unit; unpickle: InState -> 'a } +/// +/// Unit pickler, does nothing. +/// +let unit = {pickle = (fun () _ -> ()); unpickle = ignore} - /// - /// Unit pickler, does nothing. - /// - let unit = {pickle = (fun () _ -> ()); unpickle = ignore} +/// +/// Translates pickler of one type into another's +/// +let wrap (d:'a -> 'b, r: 'b -> 'a) (pu: PU<'a>) = {pickle = r >> pu.pickle; unpickle = pu.unpickle >> d} - /// - /// Translates pickler of one type into another's - /// - let wrap (d:'a -> 'b, r: 'b -> 'a) (pu: PU<'a>) = {pickle = r >> pu.pickle; unpickle = pu.unpickle >> d} +/// +/// 'wrap' helper for argumentless variants +/// +let wrap0 r = wrap ((fun () -> r), ignore) unit - /// - /// 'wrap' helper for argumentless variants - /// - let wrap0 r = wrap ((fun () -> r), ignore) unit +let byte = {pickle = (fun (b:byte) st -> st.Write(b)); unpickle = fun st -> st.ReadByte()} +let int = {pickle = (fun (i:Int32) st -> st.Write(i)); unpickle = fun st -> st.ReadInt32()} +let int64 = {pickle = (fun (i:Int64) st -> st.Write(i)); unpickle = fun st -> st.ReadInt64()} +let str = {pickle = (fun (s:string) st -> st.Write(s)); unpickle = fun st -> st.ReadString()} +let float = {pickle = (fun (s:single) st -> st.Write(s)); unpickle = fun st -> st.ReadSingle()} +let double = {pickle = (fun (s:float) st -> st.Write(s)); unpickle = fun st -> st.ReadDouble()} - let byte = {pickle = (fun (b:byte) st -> st.Write(b)); unpickle = fun st -> st.ReadByte()} - let int = {pickle = (fun (i:Int32) st -> st.Write(i)); unpickle = fun st -> st.ReadInt32()} - let int64 = {pickle = (fun (i:Int64) st -> st.Write(i)); unpickle = fun st -> st.ReadInt64()} - let str = {pickle = (fun (s:string) st -> st.Write(s)); unpickle = fun st -> st.ReadString()} - let float = {pickle = (fun (s:single) st -> st.Write(s)); unpickle = fun st -> st.ReadSingle()} - let double = {pickle = (fun (s:float) st -> st.Write(s)); unpickle = fun st -> st.ReadDouble()} +let date = wrap (DateTime.FromBinary, fun (d:DateTime) -> d.Ticks) int64 +let bool = wrap ((<>) 0uy, function | true -> 1uy |false -> 0uy) byte - let date = wrap (DateTime.FromBinary, fun (d:DateTime) -> d.Ticks) int64 - let bool = wrap ((<>) 0uy, function | true -> 1uy |false -> 0uy) byte +/// Tuple picklers +let pair pu1 pu2 = { + pickle = (fun (a,b) st -> (pu1.pickle a st : unit); (pu2.pickle b st)) + unpickle = fun st -> pu1.unpickle st, pu2.unpickle st} +let triple pu1 pu2 pu3 = { + pickle = (fun (a,b,c) st -> (pu1.pickle a st : unit); (pu2.pickle b st : unit); (pu3.pickle c st)) + unpickle = fun st -> pu1.unpickle st, pu2.unpickle st, pu3.unpickle st} - /// Tuple picklers - let pair pu1 pu2 = { - pickle = (fun (a,b) st -> (pu1.pickle a st : unit); (pu2.pickle b st)) - unpickle = fun st -> pu1.unpickle st, pu2.unpickle st} - let triple pu1 pu2 pu3 = { - pickle = (fun (a,b,c) st -> (pu1.pickle a st : unit); (pu2.pickle b st : unit); (pu3.pickle c st)) - unpickle = fun st -> pu1.unpickle st, pu2.unpickle st, pu3.unpickle st} +let quad pu1 pu2 pu3 pu4 = + wrap ((fun ((a,b),(c,d)) -> (a,b,c,d)), fun(a,b,c,d) -> (a,b),(c,d)) <| pair (pair pu1 pu2) (pair pu3 pu4) - let quad pu1 pu2 pu3 pu4 = - wrap ((fun ((a,b),(c,d)) -> (a,b,c,d)), fun(a,b,c,d) -> (a,b),(c,d)) <| pair (pair pu1 pu2) (pair pu3 pu4) +let private mux3 (a,b,c) x = (a x : unit); (b x : unit); (c x : unit) +let private mux2 (a,b) x = (a x : unit); (b x : unit) - let private mux3 (a,b,c) x = (a x : unit); (b x : unit); (c x : unit) - let private mux2 (a,b) x = (a x : unit); (b x : unit) +/// +/// List pickler. +/// +/// +let list pu = + let rec listP f = function | [] -> byte.pickle 0uy | h :: t -> mux3 (byte.pickle 1uy, f h, listP f t) + let rec listUim f acc st = match byte.unpickle st with | 0uy -> List.rev acc | 1uy -> listUim f (f st :: acc) st | n -> failwithf "listU: found number %d" n + { + pickle = listP pu.pickle + unpickle = listUim pu.unpickle [] + } - /// - /// List pickler. - /// - /// - let list pu = - let rec listP f = function | [] -> byte.pickle 0uy | h :: t -> mux3 (byte.pickle 1uy, f h, listP f t) - let rec listUim f acc st = match byte.unpickle st with | 0uy -> List.rev acc | 1uy -> listUim f (f st :: acc) st | n -> failwithf "listU: found number %d" n - { - pickle = listP pu.pickle - unpickle = listUim pu.unpickle [] - } +/// +/// Variant (discriminated union) pickler. +/// +/// Maps type to index in array of picklers. +/// Array of picklers for each type. +let alt<'a> (ftag: 'a -> Core.int) (puu: PU<'a> array): PU<'a> = + { + pickle = fun (a:'a) -> + let tag = ftag a in + mux2 (tag |> Convert.ToByte |> byte.pickle, puu.[tag].pickle a) + unpickle = fun st -> + let tag = st |> byte.unpickle |> Convert.ToInt32 in + (puu.[tag].unpickle st) + } - /// - /// Variant (discriminated union) pickler. - /// - /// Maps type to index in array of picklers. - /// Array of picklers for each type. - let alt<'a> (ftag: 'a -> Core.int) (puu: PU<'a> array): PU<'a> = - { - pickle = fun (a:'a) -> - let tag = ftag a in - mux2 (tag |> Convert.ToByte |> byte.pickle, puu.[tag].pickle a) - unpickle = fun st -> - let tag = st |> byte.unpickle |> Convert.ToInt32 in - (puu.[tag].unpickle st) - } - - /// - /// Option type pickler. - /// - let option pu = - alt - (function | None _ -> 0 | Some _ -> 1) - [| - wrap ((fun () -> None), ignore) unit - wrap (Some, Option.get) pu - |] +/// +/// Option type pickler. +/// +let option pu = + alt + (function | None -> 0 | Some _ -> 1) + [| + wrap ((fun () -> None), ignore) unit + wrap (Some, Option.get) pu + |] diff --git a/src/core/Prelude.fs b/src/core/Prelude.fs index d7fc990..9a983e5 100644 --- a/src/core/Prelude.fs +++ b/src/core/Prelude.fs @@ -1,6 +1,9 @@ [] module Prelude +/// Flips the arguments of a two-argument function. let (><) f a b = f b a +/// Active pattern that always fails with "no choice". Used as a catch-all in discriminated union matches. let inline (|OtherwiseFail|) _ = failwith "no choice" +/// Active pattern that always fails with the given error message. let inline (|OtherwiseFailErr|) message _ = failwith message diff --git a/src/core/ProcessExec.fs b/src/core/ProcessExec.fs index 5e53c39..c68f64e 100644 --- a/src/core/ProcessExec.fs +++ b/src/core/ProcessExec.fs @@ -1,42 +1,42 @@ // common tasks -namespace Xake - -module internal ProcessExec = - open System.Diagnostics - - // internal implementation - let pexec handleStd handleErr cmd args (envvars:(string * string) list) workDir = - let pinfo = - ProcessStartInfo - (cmd, args, - UseShellExecute = false, WindowStyle = ProcessWindowStyle.Hidden, - RedirectStandardError = true, RedirectStandardOutput = true) - - for name,value in envvars do - pinfo.EnvironmentVariables.[name] <- value - - match workDir with - | Some path -> pinfo.WorkingDirectory <- path - | _ -> () - - let proc = new Process(StartInfo = pinfo) - - proc.ErrorDataReceived.Add(fun e -> if e.Data <> null then handleErr e.Data) - proc.OutputDataReceived.Add(fun e -> if e.Data <> null then handleStd e.Data) - - do proc.Start() |> ignore - - do proc.BeginOutputReadLine() - do proc.BeginErrorReadLine() - - // task might be completed by that time - Async.RunSynchronously <| - async { - do! Async.Sleep 50 - if proc.HasExited then - return proc.ExitCode - else - proc.EnableRaisingEvents <- true - do! Async.AwaitEvent proc.Exited |> Async.Ignore - return proc.ExitCode - } +module internal Xake.ProcessExec + +open System.Diagnostics + +/// Starts an external process, redirecting stdout and stderr to the given handlers. +/// Returns the process exit code. +let pexec handleStd handleErr cmd args (envvars:(string * string) list) workDir = + let pinfo = + ProcessStartInfo + (cmd, args, + UseShellExecute = false, WindowStyle = ProcessWindowStyle.Hidden, + RedirectStandardError = true, RedirectStandardOutput = true) + + for name,value in envvars do + pinfo.EnvironmentVariables.[name] <- value + + match workDir with + | Some path -> pinfo.WorkingDirectory <- path + | _ -> () + + let proc = new Process(StartInfo = pinfo) + + proc.ErrorDataReceived.Add(fun e -> if e.Data <> null then handleErr e.Data) + proc.OutputDataReceived.Add(fun e -> if e.Data <> null then handleStd e.Data) + + do proc.Start() |> ignore + + do proc.BeginOutputReadLine() + do proc.BeginErrorReadLine() + + // task might be completed by that time + Async.RunSynchronously <| + async { + do! Async.Sleep 50 + if proc.HasExited then + return proc.ExitCode + else + proc.EnableRaisingEvents <- true + do! Async.AwaitEvent proc.Exited |> Async.Ignore + return proc.ExitCode + } diff --git a/src/core/Program.fs b/src/core/Program.fs index 887d0bc..d4f7ec0 100644 --- a/src/core/Program.fs +++ b/src/core/Program.fs @@ -1,6 +1,6 @@ namespace Xake -module internal ParseArgs = begin +module ParseArgs = begin type 't ParseMode = | TopLevel @@ -21,7 +21,7 @@ module internal ParseArgs = begin | "-h" | "/h" | "--help" | "/help" | "/?" | "-?" -> printf """ Usage: - fsi