From 8d24f3d1353308a4e7463f379ee050318baa6f83 Mon Sep 17 00:00:00 2001 From: cabboose Date: Sat, 30 Aug 2025 01:45:29 +0800 Subject: [PATCH] implement skeleton structure with system.commandline --- src/Fable.Cli/CommandLine.fs | 169 ++++++ src/Fable.Cli/Entry.fs | 1013 ++++++++++++++------------------ src/Fable.Cli/Fable.Cli.fsproj | 20 +- src/Fable.Cli/Spec.fs | 155 +++++ 4 files changed, 780 insertions(+), 577 deletions(-) create mode 100644 src/Fable.Cli/CommandLine.fs create mode 100644 src/Fable.Cli/Spec.fs diff --git a/src/Fable.Cli/CommandLine.fs b/src/Fable.Cli/CommandLine.fs new file mode 100644 index 000000000..0281c504c --- /dev/null +++ b/src/Fable.Cli/CommandLine.fs @@ -0,0 +1,169 @@ +// We expose the main System.CommandLine namespace types through this +// namespace so that we can alias the `System.CommandLine.Option` type. +namespace System.CommandLine.FSharp + +open System.CommandLine.Parsing + +type Argument = System.CommandLine.Argument +type ArgumentArity = System.CommandLine.ArgumentArity +type ArgumentValidation = System.CommandLine.ArgumentValidation +type Argument<'T> = System.CommandLine.Argument<'T> +type Command = System.CommandLine.Command +type CompletionSourceExtensions = System.CommandLine.CompletionSourceExtensions +type DiagramDirective = System.CommandLine.DiagramDirective +type Directive = System.CommandLine.Directive +type EnvironmentVariablesDirective = System.CommandLine.EnvironmentVariablesDirective +type InvocationConfiguration = System.CommandLine.InvocationConfiguration +type CommandOption = System.CommandLine.Option +type CommandOptionValidation = System.CommandLine.OptionValidation +type CommandOption<'T> = System.CommandLine.Option<'T> +type ParserConfiguration = System.CommandLine.ParserConfiguration +type ParseResult = System.CommandLine.ParseResult +type RootCommand = System.CommandLine.RootCommand +type Symbol = System.CommandLine.Symbol +type VersionOption = System.CommandLine.VersionOption + +module Utils = + // Static type resolution is used since ParseResult and SymbolResult share some members but are + // not within a type hierarchy. + // If a command, argument, or option is not present, then we receive ValueNone + // If the above has a default value, then we will receive a value. + let inline getCommandResult<'ParseResult when 'ParseResult: (member GetResult: Command -> CommandResult)> + (command: Command) + : 'ParseResult -> CommandResult voption + = + _.GetResult(command) >> ValueOption.ofObj + + let inline getArgumentResult<'ParseResult when 'ParseResult: (member GetResult: Argument -> ArgumentResult)> + (command: Argument) + : 'ParseResult -> ArgumentResult voption + = + _.GetResult(command) >> ValueOption.ofObj + + let inline getOptionResult<'T, 'ParseResult + when 'T :> CommandOption and 'ParseResult: (member GetResult: CommandOption -> OptionResult)> + (command: 'T) + : 'ParseResult -> OptionResult voption + = + _.GetResult(command :> CommandOption) >> ValueOption.ofObj + + let inline getNamedResult<'ParseResult when 'ParseResult: (member GetResult: string -> SymbolResult)> + (command: string) + : 'ParseResult -> SymbolResult voption + = + _.GetResult(command) >> ValueOption.ofObj + + let inline getArgumentValue<'T, 'ParseResult when 'ParseResult: (member GetValue: Argument<'T> -> 'T)> + (arg: Argument<'T>) + : 'ParseResult -> 'T voption + = + _.GetValue(arg) + >> function + | value when box value |> isNull -> ValueNone + | value -> ValueSome value + + let inline getOptionValue<'T, 'ParseResult when 'ParseResult: (member GetValue: CommandOption<'T> -> 'T)> + (cmdOption: CommandOption<'T>) + : 'ParseResult -> 'T voption + = + _.GetValue(cmdOption) + >> function + | value when box value |> isNull -> ValueNone + | value -> ValueSome value + + let inline getNamedValue<'ParseResult when 'ParseResult: (member GetValue: string -> obj)> + (arg: string) + : 'ParseResult -> obj voption + = + _.GetValue(arg) + >> function + | value when box value |> isNull -> ValueNone + | value -> ValueSome value +// Explicit warning and hint that we are mutating C# objects. Warning is for posterity +module Mutate = + let inline description desc (symbol: #Symbol) : #Symbol = + symbol.Description <- desc + symbol + + let inline hide (symbol: #Symbol) : #Symbol = + symbol.Hidden <- true + symbol + + module CommandOption = + let description = description + let hide = hide + + let addAlias alias (opt: #CommandOption) : #CommandOption = + opt.Aliases.Add alias + opt + + let require (opt: #CommandOption) : #CommandOption = + opt.Required <- true + opt + + let recursive (opt: #CommandOption) : #CommandOption = + opt.Recursive <- true + opt + // It seems these are noops in the current beta of System.CommandLine + let filePathsOnly (opt: CommandOption) : CommandOption = opt.AcceptLegalFilePathsOnly() + let fileNamesOnly (opt: CommandOption) : CommandOption = opt.AcceptLegalFileNamesOnly() + // + let valueOneOf (values: 'T seq) (opt: CommandOption<'T>) : CommandOption<'T> = + opt.AcceptOnlyFromAmong(values |> Seq.map _.ToString() |> Seq.toArray) + + let valueOneOfStrings (values: string seq) (opt: CommandOption<'T>) : CommandOption<'T> = + opt.AcceptOnlyFromAmong(values |> Seq.toArray) + + let arity (value: ArgumentArity) (opt: #CommandOption) : #CommandOption = + opt.Arity <- value + opt + // Messing with the argument result in the factory func can cause issues and is mostly unneeded + let defaultValue (value: 'T) (opt: CommandOption<'T>) : CommandOption<'T> = + opt.DefaultValueFactory <- (fun _ -> value) + opt + // Useful for options like `--language` which has many possible values (abbrevs and full names) and we want to + // only have a select few written in the help message + let helpName (msg: string) (opt: CommandOption<'T>) : CommandOption<'T> = + opt.HelpName <- msg + opt + + module Argument = + let description = description + let hide = hide + + let arity (value: ArgumentArity) (opt: #Argument) : #Argument = + opt.Arity <- value + opt + + let defaultValue (value: 'T) (arg: Argument<'T>) : Argument<'T> = + arg.DefaultValueFactory <- (fun _ -> value) + arg + + module Command = + let description = description + let hide = hide + + let addAlias alias (cmd: #Command) : #Command = + cmd.Aliases.Add alias + cmd + + let mapAction (func: ParseResult -> int) (cmd: #Command) : #Command = + cmd.SetAction(func) + cmd + + let iterAction (func: ParseResult -> int) = mapAction func >> ignore + +module CommandOption = + let create<'T> name = CommandOption<'T>(name) + +module Argument = + let create<'T> name = Argument<'T>(name) + +module RootCommand = + let create description = RootCommand(description) + +module Command = + let create name = Command(name) + let parse (argv: string array) : #Command -> ParseResult = _.Parse(argv) + let invoke: ParseResult -> int = _.Invoke() + let parseAndInvoke argv = parse argv >> invoke diff --git a/src/Fable.Cli/Entry.fs b/src/Fable.Cli/Entry.fs index 2b65dfd97..98ce51d25 100644 --- a/src/Fable.Cli/Entry.fs +++ b/src/Fable.Cli/Entry.fs @@ -1,598 +1,473 @@ module Fable.Cli.Entry open System +open System.CommandLine.FSharp +open System.CommandLine.Help +open Fable.Cli.Spec open Main open Fable open Fable.Compiler.Util open Fable.Cli.CustomLogging open Microsoft.Extensions.Logging -type CliArgs(args: string list) = - let argsMap = - let args = - // Assume last arg has true value in case it's a flag - match List.tryLast args with - | Some key when key.StartsWith('-') -> args @ [ "true" ] - | _ -> args - - (Map.empty, List.windowed 2 args) - ||> List.fold (fun map pair -> - match pair with - | [ key; value ] when key.StartsWith('-') -> - let key = key.ToLower() - - let value = - if value.StartsWith('-') then - "true" - else - value - - match Map.tryFind key map with - | Some prev -> Map.add key (value :: prev) map - | None -> Map.add key [ value ] map - | _ -> map - ) - - member _.LoweredKeys = argsMap |> Map.toList |> List.map fst +module CliArgs = + let dim = "\x1b[2m" + let dimOff = "\x1b[22m" - member _.Values(key: string) = - Map.tryFind (key.ToLower()) argsMap |> Option.defaultValue [] + let root = + RootCommand("F# transpiler; supporting F# to javascript, typescript, python, rust and others.") - member _.Value([] keys: string array) = - keys - |> Array.map (fun k -> k.ToLower()) - |> Array.tryPick (fun k -> Map.tryFind k argsMap) - |> Option.bind List.tryHead + let cleanCommand = Command.create "clean" + let watchCommand = Command.create "watch" |> Mutate.Command.addAlias "w" + let javascriptCommand = Command.create "javascript" |> Mutate.Command.addAlias "js" + let pythonCommand = Command.create "python" |> Mutate.Command.addAlias "py" + let typescriptCommand = Command.create "typescript" |> Mutate.Command.addAlias "ts" + let rustCommand = Command.create "rust" |> Mutate.Command.addAlias "rs" + let precompileCommand = Command.create "precompile" |> Mutate.hide + let phpCommand = Command.create "php" + let dartCommand = Command.create "dart" - member this.FlagOr(flag: string, defaultValue: bool) = - this.Value(flag) - |> Option.bind (fun flag -> - match Boolean.TryParse(flag) with - | true, flag -> Some flag - | false, _ -> None - ) - |> Option.defaultValue defaultValue - - member this.FlagEnabled([] flags: string array) = - flags |> Array.exists (fun flag -> this.FlagOr(flag, false)) - -let knownCliArgs () = - [ - [ "--cwd" ], [ "Working directory" ] - [ "-o"; "--outDir" ], [ "Redirect compilation output to a directory" ] - [ "-e"; "--extension" ], [ "Extension for generated JS files (default .fs.js)" ] - [ "-s"; "--sourceMaps" ], [ "Enable source maps" ] - [ "--sourceMapsRoot" ], [ "Set the value of the `sourceRoot` property in generated source maps" ] - [], [] - [ "--define" ], [ "Defines a symbol for use in conditional compilation" ] - [ "-c"; "--configuration" ], - [ - "The configuration to use when parsing .fsproj with MSBuild," - "default is 'Debug' in watch mode, or 'Release' otherwise" - ] - [ "--verbose" ], [ "Print more info during compilation" ] - [ "--silent" ], [ "Don't print any log during compilation" ] - [ "--typedArrays" ], - [ - "Compile numeric arrays as JS typed arrays (default is true for JS, false for TS)" - ] - [ "--watch" ], [ "Alias of watch command" ] - [ "--watchDelay" ], [ "Delay in ms before recompiling after a file changes (default 200)" ] - [], [] - [ "--run" ], [ "The command after the argument will be executed after compilation" ] - [ "--runFast" ], [ "The command after the argument will be executed BEFORE compilation" ] - [ "--runWatch" ], [ "Like run, but will execute after each watch compilation" ] - [ "--runScript" ], - [ - "Runs the generated script for last file with node" - """(Requires `"type": "module"` in package.json and at minimum Node.js 12.20, 14.14, or 16.0.0)""" - ] - [], [] - [ "--yes" ], [ "Automatically reply 'yes' (e.g. with `clean` command)" ] - [ "--noRestore" ], [ "Skip `dotnet restore`" ] - [ "--noCache" ], [ "Recompile all files, including sources from packages" ] - [ "--exclude" ], - [ - "Don't merge sources of referenced projects with specified pattern" - "(Intended for plugin development)" - ] - [], [] - [ "--optimize" ], [ "Compile with optimized F# AST (experimental)" ] - [ "--lang"; "--language" ], - [ - "Choose wich languages to compile to" - "" - "Available options:" - " - javascript (alias js)" - " - typescript (alias ts)" - " - python (alias py)" - " - rust (alias rs)" - " - php" - " - dart" - "" - "Default is javascript" - "" - "Support for TypeScript, Python, Rust, Php and Dart is experimental." - ] - [ "--legacyCracker" ], + let languageCommands = [ - "Use this if you have issues with the new MSBuild Cracker released in Fable 5" + javascriptCommand + typescriptCommand + pythonCommand + rustCommand + phpCommand + dartCommand ] - // Hidden args - [ "--precompiledLib" ], [] - [ "--printAst" ], [] - [ "--noReflection" ], [] - [ "--noParallelTypeCheck" ], [] - [ "--trimRootModule" ], [] - [ "--fableLib" ], [] - [ "--replace" ], [] - ] - -let printKnownCliArgs () = - knownCliArgs () - |> List.collect ( - function - | [], _ -> [ "" ] // Empty line - | args, desc -> - let args = String.concat "|" args - - match desc with - | [] -> [] // Args without description are hidden - | desc :: extraLines -> [ $" %-18s{args}{desc}"; yield! extraLines |> List.map (sprintf "%20s%s" "") ] - ) - -let generateHelp () = - $"""Usage: fable [watch] [.fsproj file or dir path] [arguments] - -Commands: - -h|--help Show help - --version Print version - watch Run Fable in watch mode - clean Remove fable_modules folders and files with specified extension (default .fs.js) - -Arguments: -{printKnownCliArgs () |> String.concat "\n"} - - Environment variables: - DOTNET_USE_POLLING_FILE_WATCHER - When set to '1' or 'true', Fable watch will poll the file system for - changes. This is required for some file systems, such as network shares, - Docker mounted volumes, and other virtual file systems. -""" - -let generateHelpWithPrefix prefixText = - $"""%s{prefixText} - -%s{generateHelp ()} - """ - -let printHelp () = generateHelp () |> Log.always - -let sanitizeCliArgs (args: CliArgs) = - let knownCliArgs = - knownCliArgs () |> List.collect fst |> List.map (fun a -> a.ToLower()) |> set - - (Ok args, args.LoweredKeys) - ||> List.fold (fun res arg -> - match res with - | Error msg -> Error msg - | Ok args -> - if knownCliArgs.Contains(arg) then - Ok args - else - $"Unknown argument: {arg}" |> generateHelpWithPrefix |> Error - ) - -let parseCliArgs (args: string list) = CliArgs(args) |> sanitizeCliArgs - -let argLanguage (args: CliArgs) = - args.Value("--lang", "--language") - |> Option.map (fun lang -> - - match lang.ToLowerInvariant() with - | "js" - | "javascript" -> Ok JavaScript - | "ts" - | "typescript" -> Ok TypeScript - | "py" - | "python" -> Ok Python - | "php" -> Ok Php - | "dart" -> Ok Dart - | "rs" - | "rust" -> Ok Rust - | unknown -> - let errorMessage = - [ - $"'{unknown}' is not a valid language." - "" - "Available options:" - " - javascript (alias js)" - " - typescript (alias ts)" - " - python (alias py)" - " - rust (alias rs)" - " - php" - " - dart" - ] - |> String.concat "\n" - - Error errorMessage - ) - |> Option.defaultValue (Ok JavaScript) - -type Runner = - static member Run - ( - args: CliArgs, - language: Language, - rootDir: string, - runProc: RunProcess option, - verbosity: Fable.Verbosity, - ?fsprojPath: string, - ?watch, - ?precompile + let compilerCommands = watchCommand :: languageCommands + let rootAndCompilerCommands = root :> Command :: compilerCommands + let allCommands = cleanCommand :: compilerCommands + let rootAndCommands = root :> Command :: allCommands + // We keep the bindings to the opts/args because it likely + // speeds up retrieval from parsed results when retrieving with + // the item instead of with the name + + // Path argument for root only + let projPath = + Argument.create "PATH" + |> Mutate.Argument.defaultValue (System.Environment.CurrentDirectory |> ValueSome) + |> Mutate.description $"{dim}Path containing project files{dimOff}" + |> Utils.addArgToCommand root + // extension argument for clean only + let extensionArg = + Argument.create "EXT" + |> Mutate.Argument.defaultValue (".fs.js" |> ValueSome) + |> Mutate.description $"{dim}Path extension for cleaning{dimOff}" + |> Utils.addArgToCommand cleanCommand + + let workingDirectory = + CommandOption.create "--cwd" + |> Mutate.description $"{dim}Set the working directory{dimOff}" + |> Mutate.CommandOption.filePathsOnly + |> Mutate.CommandOption.defaultValue System.Environment.CurrentDirectory + |> Utils.addToCommands rootAndCommands + + let verbosity = + CommandOption.create "--verbosity" + |> Mutate.description $"{dim}Set the logging volume{dimOff}" + |> Mutate.CommandOption.addAlias "-v" + |> Mutate.CommandOption.valueOneOfStrings Utils.Unions.getAllCaseStringOrInitials + |> Utils.Unions.addCustomParser ( + function + | Verbosity.Normal -> [ "n"; "normal" ] + | Verbosity.Silent -> [ "s"; "silent" ] + | Verbosity.Verbose -> [ "v"; "verbose" ] ) - = - result { - let normalizeAbsolutePath (path: string) = - (if IO.Path.IsPathRooted(path) then - path - else - IO.Path.Combine(rootDir, path)) - // Use getExactFullPath to remove things like: myrepo/./build/ - // and get proper casing (see `getExactFullPath` comment) - |> File.getExactFullPath - |> Path.normalizePath - - let watch = defaultArg watch false - let precompile = defaultArg precompile false - - let fsprojPath = - fsprojPath |> Option.map normalizeAbsolutePath |> Option.defaultValue rootDir - - let! projFile = - if IO.Directory.Exists(fsprojPath) then - let files = IO.Directory.EnumerateFileSystemEntries(fsprojPath) |> Seq.toList - - files - |> List.filter (fun file -> file.EndsWith(".fsproj", StringComparison.Ordinal)) - |> function - | [] -> - files - |> List.filter (fun file -> file.EndsWith(".fsx", StringComparison.Ordinal)) - | candidates -> candidates - |> function - | [] -> Error("Cannot find .fsproj/.fsx in dir: " + fsprojPath) - | [ fsproj ] -> Ok fsproj - | _ -> Error("Found multiple .fsproj/.fsx in dir: " + fsprojPath) - elif not (IO.File.Exists(fsprojPath)) then - Error("File does not exist: " + fsprojPath) - else - Ok fsprojPath - - let typedArrays = args.FlagOr("--typedArrays", not (language = TypeScript)) - - let outDir = args.Value("-o", "--outDir") |> Option.map normalizeAbsolutePath - - let precompiledLib = - args.Value("--precompiledLib") |> Option.map normalizeAbsolutePath - - let fableLib = args.Value "--fableLib" |> Option.map Path.normalizePath - let useMSBuildForCracking = args.FlagOr("--legacyCracker", true) - - do! - match watch, outDir, fableLib with - | true, _, _ when precompile -> Error("Cannot watch when precompiling") - | _, None, _ when precompile -> Error("outDir must be specified when precompiling") - | _, _, Some _ when Option.isSome precompiledLib -> - Error("Cannot set fableLib when setting precompiledLib") - | _ -> Ok() - - do! - let reservedDirs = [ Naming.fableModules; "obj" ] - - let outDirLast = - outDir - |> Option.bind (fun outDir -> outDir.TrimEnd('/').Split('/') |> Array.tryLast) - |> Option.defaultValue "" - - if List.contains outDirLast reservedDirs then - Error($"{outDirLast} is a reserved directory, please use another output directory") - // TODO: Remove this check when typed arrays are compatible with typescript - elif language = TypeScript && typedArrays then - Error("Typescript output is currently not compatible with typed arrays, pass: --typedArrays false") - else - Ok() - - let configuration = - let defaultConfiguration = - if watch then - "Debug" - else - "Release" - - match args.Value("-c", "--configuration") with - | None -> defaultConfiguration - | Some c when String.IsNullOrWhiteSpace c -> defaultConfiguration - | Some configurationArg -> configurationArg - - let define = - args.Values "--define" - |> List.append - [ - "FABLE_COMPILER" - "FABLE_COMPILER_5" - match language with - | Php -> "FABLE_COMPILER_PHP" - | Rust -> "FABLE_COMPILER_RUST" - | Dart -> "FABLE_COMPILER_DART" - | Python -> "FABLE_COMPILER_PYTHON" - | TypeScript -> "FABLE_COMPILER_TYPESCRIPT" - | JavaScript -> "FABLE_COMPILER_JAVASCRIPT" - ] - |> List.distinct - - let fileExt = - args.Value("-e", "--extension") - |> Option.map (fun e -> - if e.StartsWith('.') then - e - else - "." + e - ) - |> Option.defaultWith (fun () -> - let usesOutDir = Option.isSome outDir - File.defaultFileExt usesOutDir language - ) - - let compilerOptions = - CompilerOptionsHelper.Make( - language = language, - typedArrays = typedArrays, - fileExtension = fileExt, - define = define, - debugMode = (configuration = "Debug"), - optimizeFSharpAst = args.FlagEnabled "--optimize", - noReflection = args.FlagEnabled "--noReflection", - verbosity = verbosity - ) - - let cliArgs = - { - ProjectFile = Path.normalizeFullPath projFile - FableLibraryPath = fableLib - RootDir = rootDir - Configuration = configuration - OutDir = outDir - IsWatch = watch - Precompile = precompile - PrecompiledLib = precompiledLib - PrintAst = args.FlagEnabled "--printAst" - SourceMaps = args.FlagEnabled "-s" || args.FlagEnabled "--sourceMaps" - SourceMapsRoot = args.Value "--sourceMapsRoot" - NoRestore = args.FlagEnabled "--noRestore" - NoCache = args.FlagEnabled "--noCache" - // TODO: If we select optimize we cannot have F#/Fable parallelization - NoParallelTypeCheck = args.FlagEnabled "--noParallelTypeCheck" - Exclude = args.Values "--exclude" - Replace = - args.Values "--replace" - |> List.map (fun v -> - let v = v.Split(':') - v.[0], normalizeAbsolutePath v.[1] - ) - |> Map - RunProcess = runProc - CompilerOptions = compilerOptions - Verbosity = verbosity - } - - let watchDelay = - if watch then - args.Value("--watchDelay") |> Option.map int |> Option.defaultValue 200 |> Some - else - None - - let startCompilation () = - State.Create(cliArgs, ?watchDelay = watchDelay, useMSBuildForCracking = useMSBuildForCracking) - |> startCompilationAsync - |> Async.RunSynchronously - - return! - // In CI builds, it may happen that two parallel Fable compilations try to precompile - // the same library at the same time, use a lock file to prevent issues in that case. - match outDir, precompile, watch with - | Some outDir, true, false -> File.withLock outDir startCompilation - | _ -> startCompilation () - |> Result.mapEither ignore fst - } - -let clean (args: CliArgs) language rootDir = - let ignoreDirs = set [ "bin"; "obj"; "node_modules" ] - - let outDir = args.Value("-o", "--outDir") - - let fileExt = - args.Value("-e", "--extension") - |> Option.defaultWith (fun () -> - let usesOutDir = Option.isSome outDir - File.defaultFileExt usesOutDir language + |> Mutate.CommandOption.defaultValue Verbosity.Normal + |> Mutate.CommandOption.helpName $"{dim}n|normal|s|silent|v|verbose{dimOff}" + |> Utils.addToCommands rootAndCommands + + /// DEPRECATED - TODO remove in Fable v6 + let silent = + CommandOption.create "--silent" + |> Mutate.hide + |> Utils.addToCommands rootAndCommands + + /// DEPRECATED - TODO remove in Fable v6 + let verbose = + CommandOption.create "--verbose" + |> Mutate.hide + |> Utils.addToCommands rootAndCommands + + let language = + CommandOption.create "--language" + |> Mutate.description $"{dim}Set the target language for the transpiler{dimOff}" + |> Mutate.CommandOption.addAlias "--lang" + |> Mutate.CommandOption.addAlias "-l" + |> Mutate.CommandOption.valueOneOfStrings + [ + "js" + "javascript" + "ts" + "typescript" + "py" + "python" + "rs" + "rust" + "php" + "dart" + ] + |> Mutate.CommandOption.helpName $"{dim}javascript|typescript|python|rust|php|dart{dimOff}" + |> Utils.Unions.addCustomParser ( + function + | JavaScript -> [ "js"; "javascript" ] + | TypeScript -> [ "ts"; "typescript" ] + | Python -> [ "py"; "python" ] + | Rust -> [ "rs"; "rust" ] + | Php -> [ "php" ] + | Dart -> [ "dart" ] ) + |> Mutate.CommandOption.defaultValue JavaScript + |> Utils.addToCommands [ watchCommand; root ] + + let extension = + CommandOption.create "--extension" + |> Mutate.description $"{dim}The file extension for Fable generated source files{dimOff}" + |> Mutate.CommandOption.addAlias "-e" + |> Mutate.CommandOption.defaultValue ".fs.js" + |> Utils.addToCommands rootAndCommands + + let yes = + CommandOption.create "--yes" + |> Mutate.description $"{dim}Automatically respond yes to prompts.{dimOff}" + |> Utils.addToCommands rootAndCommands + + let definitions = + CommandOption.create "--define" + |> Mutate.description $"{dim}Add symbols for use in conditional preprocessing{dimOff}" + |> Mutate.CommandOption.addAlias "-d" + |> Utils.addToCommands rootAndCompilerCommands + + let output = + CommandOption.create "--output" + |> Mutate.CommandOption.addAlias "-o" + |> Mutate.CommandOption.description $"{dim}Set the output directory for generated source files{dimOff}" + |> Mutate.CommandOption.filePathsOnly + |> Utils.addToCommands rootAndCommands + + let config = + CommandOption.create "--config" + |> Mutate.CommandOption.addAlias "-c" + |> Mutate.description $"{dim}Set the build configuration type{dimOff}" + |> Mutate.CommandOption.valueOneOfStrings [ "Debug"; "Release" ] + |> Mutate.CommandOption.helpName $"{dim}Debug|Release{dimOff}" + |> Utils.Unions.addCustomParser ( + function + | Release -> [ "Release" ] + | Debug -> [ "Debug" ] + ) + |> Utils.addToCommands rootAndCompilerCommands + + let watch = + CommandOption.create "--watch" + |> Mutate.description $"{dim}Run the compiler in watch mode{dimOff}" + |> Utils.addToCommands (rootAndCompilerCommands |> List.except [ watchCommand ]) + + let watchDelay = + CommandOption.create "--watchDelay" + |> Mutate.description $"{dim}Delay between file changes and recompilation in watch mode{dimOff}" + |> Mutate.CommandOption.defaultValue 200 + |> Utils.addToCommands rootAndCompilerCommands + + let run = + CommandOption.create "--run" + |> Mutate.description $"{dim}Command line arguments that are run after compilation (enclose in strings){dimOff}" + |> Utils.addToCommands rootAndCompilerCommands + + let runFast = + CommandOption.create "--runFast" + |> Mutate.description + $"{dim}Command line arguments that are run before compilation (enclose in strings){dimOff}" + |> Utils.addToCommands rootAndCompilerCommands + + let runWatch = + CommandOption.create "--runWatch" + |> Mutate.description + $"{dim}Command line arguments that are run whenever recompilation occurs in watch mode{dimOff}" + |> Utils.addToCommands rootAndCompilerCommands + + let noRestore = + CommandOption.create "--noRestore" + |> Mutate.description $"{dim}TODO{dimOff}" + |> Utils.addToCommands rootAndCompilerCommands + + let noCache = + CommandOption.create "--noCache" + |> Mutate.description $"{dim}TODO{dimOff}" + |> Utils.addToCommands rootAndCompilerCommands + + let exclude = + CommandOption.create "--exclude" + |> Mutate.description $"{dim}Exclude paths from caching - used in plugin development{dimOff}" + |> Utils.addToCommands rootAndCompilerCommands + + let optimize = + CommandOption.create "--optimize" + |> Utils.addToCommands rootAndCompilerCommands + + let legacyCracker = + CommandOption.create "--legacyCracker" + |> Utils.addToCommands rootAndCompilerCommands + + let printAst = + CommandOption.create "--printAst" + |> Mutate.hide + |> Utils.addToCommands rootAndCompilerCommands + + let trimRootModule = + CommandOption.create "--trimRootModule" + |> Mutate.hide + |> Utils.addToCommands rootAndCompilerCommands + + let fableLib = + CommandOption.create "--fableLib" + |> Mutate.hide + |> Utils.addToCommands rootAndCompilerCommands + + let replace = + CommandOption.create "--replace" + |> Mutate.hide + |> Utils.addToCommands rootAndCompilerCommands + + let precompiledLib = + CommandOption.create "--precompiledLib" + |> Utils.addToCommands rootAndCompilerCommands + |> Mutate.hide + + let noReflection = + CommandOption.create "--noReflection" + |> Mutate.hide + |> Utils.addToCommands rootAndCompilerCommands + + let noParallelTypeCheck = + CommandOption.create "--noParallelTypeCheck" + |> Mutate.hide + |> Utils.addToCommands rootAndCompilerCommands + + let typedArrays = + CommandOption.create "--typedArrays" + |> Utils.addToCommands [ javascriptCommand; typescriptCommand; watchCommand; root ] + + let sourceMap = + CommandOption.create "--sourceMap" + |> Utils.addToCommands [ javascriptCommand; typescriptCommand; watchCommand; root ] + + let sourceMapRoot = + CommandOption.create "--sourceMapRoot" + |> Utils.addToCommands [ javascriptCommand; typescriptCommand; watchCommand; root ] + + let runScript = + CommandOption.create "--runScript" + |> Utils.addToCommands [ javascriptCommand; typescriptCommand; watchCommand; root ] + +// let clean (args: CliArgs) language rootDir = +// let ignoreDirs = set [ "bin"; "obj"; "node_modules" ] +// +// let outDir = args.Value("-o", "--outDir") +// +// let fileExt = +// args.Value("-e", "--extension") +// |> Option.defaultWith (fun () -> +// let usesOutDir = Option.isSome outDir +// File.defaultFileExt usesOutDir language +// ) +// +// let cleanDir = outDir |> Option.defaultValue rootDir |> IO.Path.GetFullPath +// +// // clean is a potentially destructive operation, we need a permission before proceeding +// Console.WriteLine("This will recursively delete all *{0}[.map] files in {1}", fileExt, cleanDir) +// +// if not (args.FlagEnabled "--yes") then +// Console.WriteLine("Please press 'Y' or 'y' if you want to continue: ") +// let keyInfo = Console.ReadKey() +// Console.WriteLine() +// +// if keyInfo.Key <> ConsoleKey.Y then +// Console.WriteLine("Clean was cancelled.") +// exit 0 +// +// let mutable fileCount = 0 +// let mutable fableModulesDeleted = false +// +// let rec recClean dir = +// seq { +// yield! IO.Directory.GetFiles(dir, "*" + fileExt) +// yield! IO.Directory.GetFiles(dir, "*" + fileExt + ".map") +// } +// |> Seq.iter (fun file -> +// IO.File.Delete(file) +// fileCount <- fileCount + 1 +// Log.verbose (lazy ("Deleted " + file)) +// ) +// +// IO.Directory.GetDirectories(dir) +// |> Array.filter (fun subdir -> ignoreDirs.Contains(IO.Path.GetFileName(subdir)) |> not) +// |> Array.iter (fun subdir -> +// if IO.Path.GetFileName(subdir) = Naming.fableModules then +// IO.Directory.Delete(subdir, true) +// fableModulesDeleted <- true +// +// Log.always $"Deleted {IO.Path.GetRelativePath(rootDir, subdir)}" +// else +// recClean subdir +// ) +// +// recClean cleanDir +// +// if fileCount = 0 && not fableModulesDeleted then +// Log.always ("No files have been deleted. If Fable output is in another directory, pass it as argument.") +// else +// Log.always ("Clean completed! Files deleted: " + string fileCount) + +// +// let private logPrelude commands language = +// match commands with +// | [ "--version" ] -> () +// | _ -> +// let status = +// match getStatus language with +// | "stable" +// | "" -> "" +// | status -> $" (status: {status})" +// +// Log.always ($"Fable {Literals.VERSION}: F# to {language} compiler{status}") +// +// match getLibPkgVersion language with +// | Some(repository, pkgName, version) -> +// Log.always ($"Minimum {pkgName} version (when installed from {repository}): {version}") +// | None -> () +// +// Log.always ("\nThanks to the contributor! @" + Contributors.getRandom ()) +// +// Log.always ("Stand with Ukraine! https://standwithukraine.com.ua/" + "\n") + +let makeCliOptions (command: Command) (parseResult: ParseResult) : ICliOptions = + let getValueOrDefault defaultValue opt = + parseResult |> Utils.getOptionValue opt |> ValueOption.defaultValue defaultValue + + { new ICliOptions with + member this.workDir = + CliArgs.workingDirectory |> getValueOrDefault Environment.CurrentDirectory + + member this.projPath = + parseResult + |> Utils.getArgumentValue CliArgs.projPath + |> ValueOption.flatten + |> ValueOption.defaultValue Environment.CurrentDirectory + + member this.verbosity = + let silent = CliArgs.silent |> getValueOrDefault false + let verbose = CliArgs.verbose |> getValueOrDefault false + + CliArgs.verbosity + |> getValueOrDefault Verbosity.Normal + |> function + | Verbosity.Normal when verbose -> Verbosity.Verbose + | Verbosity.Normal when silent -> Verbosity.Silent + | verbosity -> verbosity + + member this.language = CliArgs.language |> getValueOrDefault Language.JavaScript + member this.yes = CliArgs.yes |> getValueOrDefault false + + member this.defines = + CliArgs.definitions + |> getValueOrDefault [||] + |> Array.toList + |> List.append + [ + "FABLE_COMPILER" + "FABLE_COMPILER_5" + CliArgs.language + |> getValueOrDefault Language.JavaScript + |> _.ToString().ToUpper() + |> sprintf "FABLE_COMPILER_%s" + ] - let cleanDir = outDir |> Option.defaultValue rootDir |> IO.Path.GetFullPath - - // clean is a potentially destructive operation, we need a permission before proceeding - Console.WriteLine("This will recursively delete all *{0}[.map] files in {1}", fileExt, cleanDir) + member this.output = parseResult |> Utils.getOptionValue CliArgs.output - if not (args.FlagEnabled "--yes") then - Console.WriteLine("Please press 'Y' or 'y' if you want to continue: ") - let keyInfo = Console.ReadKey() - Console.WriteLine() + member this.config = + let isWatching = + getValueOrDefault false CliArgs.watch || command = CliArgs.watchCommand - if keyInfo.Key <> ConsoleKey.Y then - Console.WriteLine("Clean was cancelled.") - exit 0 + parseResult + |> Utils.getOptionValue CliArgs.config + |> function + | ValueSome config -> config + | ValueNone when isWatching -> BuildConfig.Debug + | ValueNone -> BuildConfig.Release + + member this.watch = + getValueOrDefault false CliArgs.watch || command = CliArgs.watchCommand + + member this.watchDelay = CliArgs.watchDelay |> getValueOrDefault 200 + member this.run = parseResult |> Utils.getOptionValue CliArgs.run + member this.runFast = parseResult |> Utils.getOptionValue CliArgs.runFast + member this.runWatch = parseResult |> Utils.getOptionValue CliArgs.runWatch + member this.noRestore = CliArgs.noRestore |> getValueOrDefault false + member this.noCache = CliArgs.noCache |> getValueOrDefault false + member this.exclude = CliArgs.exclude |> getValueOrDefault [||] + member this.optimize = CliArgs.optimize |> getValueOrDefault false + member this.legacyCracker = CliArgs.legacyCracker |> getValueOrDefault false + member this.printAst = CliArgs.printAst |> getValueOrDefault false + member this.trimRootModule = CliArgs.trimRootModule |> getValueOrDefault false + member this.fableLib = parseResult |> Utils.getOptionValue CliArgs.fableLib + + member this.replace = + CliArgs.replace + |> getValueOrDefault [||] + |> Array.map _.Split(':', 2) + // TODO + |> Array.filter (Array.length >> (=) 2) + |> Array.map ( + function + | [| a; b |] -> a, b + | _ -> failwith "Unreachable" + ) + |> Map - let mutable fileCount = 0 - let mutable fableModulesDeleted = false + member this.precompiledLib = parseResult |> Utils.getOptionValue CliArgs.precompiledLib + member this.noReflection = CliArgs.noReflection |> getValueOrDefault false - let rec recClean dir = - seq { - yield! IO.Directory.GetFiles(dir, "*" + fileExt) - yield! IO.Directory.GetFiles(dir, "*" + fileExt + ".map") - } - |> Seq.iter (fun file -> - IO.File.Delete(file) - fileCount <- fileCount + 1 - Log.verbose (lazy ("Deleted " + file)) - ) + member this.noParallelTypeCheck = + CliArgs.noParallelTypeCheck |> getValueOrDefault false - IO.Directory.GetDirectories(dir) - |> Array.filter (fun subdir -> ignoreDirs.Contains(IO.Path.GetFileName(subdir)) |> not) - |> Array.iter (fun subdir -> - if IO.Path.GetFileName(subdir) = Naming.fableModules then - IO.Directory.Delete(subdir, true) - fableModulesDeleted <- true + member this.typedArrays = CliArgs.typedArrays |> getValueOrDefault false + member this.sourceMap = CliArgs.sourceMap |> getValueOrDefault false + member this.sourceMapRoot = parseResult |> Utils.getOptionValue CliArgs.sourceMapRoot + member this.runScript = parseResult |> Utils.getOptionValue CliArgs.runScript - Log.always $"Deleted {IO.Path.GetRelativePath(rootDir, subdir)}" - else - recClean subdir - ) - - recClean cleanDir - - if fileCount = 0 && not fableModulesDeleted then - Log.always ("No files have been deleted. If Fable output is in another directory, pass it as argument.") - else - Log.always ("Clean completed! Files deleted: " + string fileCount) - -let getStatus = - function - | JavaScript - | TypeScript -> "stable" - | Python -> "beta" - | Rust -> "alpha" - | Dart -> "beta" - | Php -> "experimental" - -let getLibPkgVersion = - function - | JavaScript -> Some("npm", "@fable-org/fable-library-js", Literals.JS_LIBRARY_VERSION) - | TypeScript -> Some("npm", "@fable-org/fable-library-ts", Literals.JS_LIBRARY_VERSION) - | Python - | Rust - | Dart - | Php -> None - -let private logPrelude commands language = - match commands with - | [ "--version" ] -> () - | _ -> - let status = - match getStatus language with - | "stable" - | "" -> "" - | status -> $" (status: {status})" - - Log.always ($"Fable {Literals.VERSION}: F# to {language} compiler{status}") - - match getLibPkgVersion language with - | Some(repository, pkgName, version) -> - Log.always ($"Minimum {pkgName} version (when installed from {repository}): {version}") - | None -> () - - Log.always ("\nThanks to the contributor! @" + Contributors.getRandom ()) - - Log.always ("Stand with Ukraine! https://standwithukraine.com.ua/" + "\n") + } [] let main argv = + CliArgs.allCommands |> List.iter CliArgs.root.Add + + CliArgs.watchCommand + |> Mutate.Command.mapAction (fun result -> + result |> printfn "PRINTING FROM WATCH %A" + + result + |> Utils.getOptionResult CliArgs.config + |> fun x -> + x |> printfn "%A" + x + |> ValueOption.iter (printfn "PRINTING CONFIG %A") + + result |> Utils.getCommandResult CliArgs.typescriptCommand |> printfn "%A" + result |> Utils.getOptionResult CliArgs.extension |> printfn "%A" + 0 + ) + |> ignore - let createLogger level = - use factory = - LoggerFactory.Create(fun builder -> - builder.SetMinimumLevel(level).AddCustomConsole(fun options -> options.UseNoPrefixMsgStyle <- true) - |> ignore - ) - - factory.CreateLogger("") - - // Set an initial logger in case, we fail to parse the CLI args - Log.setLogger Verbosity.Normal (createLogger LogLevel.Information) + CliArgs.root + |> Mutate.Command.mapAction (fun result -> + result + |> Utils.getCommandResult CliArgs.watchCommand + |> ValueOption.iter (printfn "PRINTING FROM ROOT %A") - result { - let! argv, runProc = - argv - |> List.ofArray - |> List.splitWhile (fun a -> not (a.StartsWith("--run", StringComparison.Ordinal))) - |> function - | argv, flag :: runArgs -> - match flag, runArgs with - | "--run", exeFile :: args -> Ok(RunProcess(exeFile, args)) - | "--runFast", exeFile :: args -> Ok(RunProcess(exeFile, args, fast = true)) - | "--runWatch", exeFile :: args -> Ok(RunProcess(exeFile, args, watch = true)) - | "--runScript", args -> Ok(RunProcess(Naming.placeholder, args, watch = true)) - | _, [] -> Error("Missing command after " + flag) - | _ -> Error("Unknown argument " + flag) - |> Result.map (fun runProc -> argv, Some runProc) - | argv, [] -> Ok(argv, None) - - let commands, args = - match argv with - | ("help" | "--help" | "-h") :: _ -> [ "--help" ], [] - | "--version" :: _ -> [ "--version" ], [] - | argv -> argv |> List.splitWhile (fun x -> x.StartsWith('-') |> not) - - let! args = parseCliArgs args - let! language = argLanguage args - Compiler.SetLanguageUnsafe language - - let rootDir = - match args.Value "--cwd" with - | Some rootDir -> File.getExactFullPath rootDir - | None -> IO.Directory.GetCurrentDirectory() - - let level, verbosity = - match commands with - | [ "--version" ] -> LogLevel.Information, Verbosity.Normal - | _ -> - if args.FlagEnabled "--verbose" then - LogLevel.Debug, Verbosity.Verbose - else - LogLevel.Information, Verbosity.Normal - - // Override the logger now that we know the verbosity level - Log.setLogger verbosity (createLogger level) - - logPrelude commands language - - match commands with - | [ "--help" ] -> return printHelp () - | [ "--version" ] -> return Log.always Literals.VERSION - | [ "clean"; dir ] -> return clean args language dir - | [ "clean" ] -> return clean args language rootDir - | [ "watch"; path ] -> - return! Runner.Run(args, language, rootDir, runProc, verbosity, fsprojPath = path, watch = true) - | [ "watch" ] -> return! Runner.Run(args, language, rootDir, runProc, verbosity, watch = true) - | [ "precompile"; path ] -> - return! Runner.Run(args, language, rootDir, runProc, verbosity, fsprojPath = path, precompile = true) - | [ "precompile" ] -> return! Runner.Run(args, language, rootDir, runProc, verbosity, precompile = true) - | [ path ] -> - return! - Runner.Run( - args, - language, - rootDir, - runProc, - verbosity, - fsprojPath = path, - watch = args.FlagEnabled("--watch") - ) - | [] -> return! Runner.Run(args, language, rootDir, runProc, verbosity, watch = args.FlagEnabled("--watch")) - | _ -> return! "Unexpected arguments" |> generateHelpWithPrefix |> Error - } - |> function - | Ok _ -> 0 - | Error msg -> - Log.error msg - 1 + 0 + ) + |> Command.parseAndInvoke argv diff --git a/src/Fable.Cli/Fable.Cli.fsproj b/src/Fable.Cli/Fable.Cli.fsproj index 4af64b050..91144eb76 100644 --- a/src/Fable.Cli/Fable.Cli.fsproj +++ b/src/Fable.Cli/Fable.Cli.fsproj @@ -13,15 +13,17 @@ F# to JS compiler $(OtherFlags) --nowarn:3536 + + + + + + + + - - - - - - - - + + @@ -47,8 +49,10 @@ runtime; build; native; contentfiles; analyzers; buildtransitive all + + diff --git a/src/Fable.Cli/Spec.fs b/src/Fable.Cli/Spec.fs new file mode 100644 index 000000000..672cf23a5 --- /dev/null +++ b/src/Fable.Cli/Spec.fs @@ -0,0 +1,155 @@ +module Fable.Cli.Spec + +open System.CommandLine +open System.CommandLine.FSharp +open Fable + + +// Specification of CLI settings reflected by interfaces + +// Status is turned to a union so we can control things like stringification +// for style +[] +type LanguageStatus = + | Stable + | Beta + | Alpha + | Experimental + + override this.ToString() = + match this with + | Stable -> "stable" + | Beta -> "beta" + | Alpha -> "alpha" + | Experimental -> "experimental" + +[] +type BuildConfig = + | Release + | Debug + +let getStatus = + function + | JavaScript + | TypeScript -> Stable + | Dart + | Python -> Beta + | Rust -> Alpha + | Php -> Experimental + +let getLibPkgVersion = + function + | JavaScript -> ValueSome("npm", "@fable-org/fable-library-js", Literals.JS_LIBRARY_VERSION) + | TypeScript -> ValueSome("npm", "@fable-org/fable-library-ts", Literals.JS_LIBRARY_VERSION) + | Python + | Rust + | Dart + | Php -> ValueNone + +type ICommonOptions = + abstract workDir: string + abstract projPath: string + abstract verbosity: Verbosity + abstract language: Language + abstract yes: bool + +type ICompileOptions = + inherit ICommonOptions + abstract defines: string list + abstract output: string voption + abstract config: BuildConfig + abstract watch: bool + abstract watchDelay: int + abstract run: string voption + abstract runFast: string voption + abstract runWatch: string voption + abstract noRestore: bool + abstract noCache: bool + abstract exclude: string[] + abstract optimize: bool + abstract legacyCracker: bool + abstract printAst: bool + abstract trimRootModule: bool + abstract fableLib: string voption + abstract replace: Map + abstract precompiledLib: string voption + abstract noReflection: bool + abstract noParallelTypeCheck: bool + +type IJavaScriptOptions = + inherit ICompileOptions + abstract typedArrays: bool + abstract sourceMap: bool + abstract sourceMapRoot: string voption + abstract runScript: string voption + +type ITypeScriptOptions = + inherit IJavaScriptOptions + +type IPythonOptions = + inherit ICompileOptions + +type IRustOptions = + inherit ICompileOptions + +type IDartOptions = + inherit ICompileOptions + +type IPhpOptions = + inherit ICompileOptions + +type ICliOptions = + inherit ICommonOptions + inherit ICompileOptions + inherit IJavaScriptOptions + inherit ITypeScriptOptions + inherit IPythonOptions + inherit IRustOptions + inherit IDartOptions + inherit IPhpOptions + +module Utils = + open FSharp.Reflection + + module Unions = + let getAllCaseStringOrInitials<'T> = + FSharpType.GetUnionCases typeof<'T> + |> Array.map _.Name + |> Array.collect (fun case -> + match case.Length with + | 0 -> [||] + | 1 -> [| case.ToLower() |] + | _ -> [| case.ToLower(); (string case[0]).ToLower() |] + ) + + let addCustomParser (map: 'T -> string list) (opt: CommandOption<'T>) : CommandOption<'T> = + let caseParsers = + FSharpType.GetUnionCases typeof<'T> + |> Array.map (fun case -> + let caseValue = FSharpValue.MakeUnion(case, [||]) + caseValue |> unbox<'T>, caseValue |> unbox<'T> |> map + ) + |> fun possibles (inputCase: string) -> + possibles + |> Array.tryFind (snd >> List.map _.ToLower() >> List.contains (inputCase.ToLower())) + |> Option.map fst + |> Option.get + + opt.CustomParser <- (fun parseResult -> parseResult.Tokens[0].Value |> caseParsers) + opt + + let addToCommands (commands: #Command list) (opt: CommandOption<'T>) = + commands |> List.iter _.Add(opt) + opt + + let addToCommand (command: #Command) (opt: CommandOption<'T>) = + command.Add(opt) + opt + + let addArgToCommands (commands: #Command list) (arg: Argument<'T>) = + commands |> List.iter _.Add(arg) + arg + + let addArgToCommand (command: #Command) (arg: Argument<'T>) = + command.Add arg + arg