fix kiss-vscode tests
This commit is contained in:
@@ -1,5 +1,7 @@
|
||||
// This also loads Util.kiss:
|
||||
(load "commands/ExtensionTools.kiss")
|
||||
(#if test
|
||||
(load "Util.kiss")
|
||||
// This also loads Util.kiss:
|
||||
(load "commands/ExtensionTools.kiss"))
|
||||
|
||||
(function userHome [] (or (Sys.getEnv "MSYSHOME") (Sys.getEnv "HOME") (Sys.getEnv "UserProfile")))
|
||||
(function userConfigDir []
|
||||
@@ -23,6 +25,8 @@
|
||||
(cmd.shift))]
|
||||
(trySpawnSync program cmd (object cwd activeConfigDir) handleConfigFailure)))
|
||||
|
||||
(#when test (var :String->Void warningMessage Prelude.printStr))
|
||||
|
||||
(function :Void tryLoadConfig [&opt :Bool force :Bool fallbackToDefault :String _]
|
||||
(let [handleConfigFailure
|
||||
->errorMessage {
|
||||
@@ -122,7 +126,8 @@
|
||||
(let [uniqueConfigFile (joinPath activeConfigDir "$(.toShort (Uuid.v4)).js")]
|
||||
(File.copy file uniqueConfigFile)
|
||||
(set config (the KissConfig .KissConfig (Node.require uniqueConfigFile)))
|
||||
(set Prelude.printStr ->:Void s (Vscode.window.showInformationMessage s))
|
||||
(#unless test
|
||||
(set Prelude.printStr ->:Void s (Vscode.window.showInformationMessage s)))
|
||||
(set config.tryLoadConfig ->[&opt _] (tryLoadConfig true false))
|
||||
(set config.extensionPath extensionPath)
|
||||
(config.prepareInterp)
|
||||
|
||||
@@ -1,118 +1,3 @@
|
||||
/**
|
||||
* Aliases
|
||||
*/
|
||||
|
||||
// output
|
||||
(defAlias &call infoMessage Vscode.window.showInformationMessage)
|
||||
(defAlias &call warningMessage Vscode.window.showWarningMessage)
|
||||
(defAlias &call errorMessage Vscode.window.showErrorMessage)
|
||||
|
||||
// input
|
||||
(defAlias &call inputBox Vscode.window.showInputBox)
|
||||
(defAlias &call _quickPick Vscode.window.showQuickPick)
|
||||
|
||||
(function quickPickItem [label &opt description]
|
||||
(object
|
||||
label label
|
||||
description description
|
||||
detail null
|
||||
picked null
|
||||
alwaysShow null))
|
||||
|
||||
(function quickPick [:Array<String> strings]
|
||||
(awaitLet [chosenItem (_quickPick (for string strings (quickPickItem string)))]
|
||||
(when chosenItem chosenItem.label)))
|
||||
|
||||
// thanks https://stackoverflow.com/a/69842249
|
||||
(function autoSuggestPick [:Array<String> strings]
|
||||
(new js.lib.Promise
|
||||
->[resolve reject] (let [qp (Vscode.window.createQuickPick)
|
||||
:Array<Dynamic> items (for string strings (quickPickItem string))]
|
||||
(set qp.items items)
|
||||
(qp.onDidChangeValue
|
||||
->v (unlessLet [(Some _) (indexOf strings v)]
|
||||
(set qp.items (concat [(quickPickItem v)] items))))
|
||||
(qp.onDidAccept
|
||||
->_ {
|
||||
(resolve .label (first qp.activeItems))
|
||||
(qp.hide)
|
||||
})
|
||||
(qp.show))))
|
||||
|
||||
(function :js.lib.Promise.Thenable<Dynamic> quickPickMap [:Map<String,Dynamic> stringMap]
|
||||
(awaitLet [chosenItem (_quickPick (for =>key value stringMap (quickPickItem key (Std.string value))))]
|
||||
(when chosenItem (dictGet stringMap chosenItem.label))))
|
||||
|
||||
(defAlias &call openDialog Vscode.window.showOpenDialog)
|
||||
|
||||
// commands
|
||||
(defAlias &call executeCommand Vscode.commands.executeCommand)
|
||||
(function repeatCommand [command times]
|
||||
(let [iteration
|
||||
->[&opt _] (executeCommand command)
|
||||
&mut promise
|
||||
(iteration)]
|
||||
(doFor i (range (- times 1))
|
||||
(set promise (promise.then iteration)))
|
||||
promise))
|
||||
|
||||
(defMacro awaitCommands [commandsAndArgs &builder b &body body]
|
||||
(let [commandsAndArgs
|
||||
(if (isListExp commandsAndArgs)
|
||||
(.copy (expList commandsAndArgs))
|
||||
(throw (CompileError.fromExp commandsAndArgs "First argument to awaitCommands should be a list of commands with optional argument arrays")))
|
||||
bindings []]
|
||||
(while commandsAndArgs
|
||||
(bindings.push (b.symbol "_"))
|
||||
(let [nextCommand (commandsAndArgs.shift)]
|
||||
(bindings.push (b.callSymbol "executeCommand"
|
||||
(concat [nextCommand] (if (and commandsAndArgs (isListExp (first commandsAndArgs))) (expList (commandsAndArgs.shift)) []))))))
|
||||
`(awaitLet ,bindings ,@body)))
|
||||
|
||||
// Other
|
||||
|
||||
(defAlias &call showTextDocument Vscode.window.showTextDocument)
|
||||
(defAlias &call openTextDocument Vscode.workspace.openTextDocument)
|
||||
|
||||
// Macros for implementing commands in Kiss
|
||||
|
||||
(defMacro withValueOrInputBox [v &body body]
|
||||
`{
|
||||
(if ,v
|
||||
{,@body}
|
||||
(awaitLet [,v (inputBox)]
|
||||
,@body))
|
||||
null
|
||||
})
|
||||
|
||||
(defMacro withValueOrQuickPick [v options &body body]
|
||||
`(if ,v
|
||||
{,@body}
|
||||
(awaitLet [,v (quickPick ,options)]
|
||||
,@body)))
|
||||
|
||||
(defMacro withValueOrQuickPickMap [v options &body body]
|
||||
`(if ,v
|
||||
{,@body}
|
||||
(awaitLet [,v (quickPickMap ,options)]
|
||||
,@body)))
|
||||
|
||||
(function :Void chooseFileInDir [:String->Void openFile :Bool allowNew &opt :String dir]
|
||||
(withValueOrInputBox dir
|
||||
(set dir (dir.replace "\\" "/"))
|
||||
(when (dir.endsWith "/") (set dir (substr dir 0 -1)))
|
||||
(awaitLet [dirOrFile ((if allowNew autoSuggestPick quickPick) (concat [".."] (sys.FileSystem.readDirectory dir)))]
|
||||
(let [dirOrFile
|
||||
(case dirOrFile
|
||||
(".."
|
||||
(substr dir 0 (dir.lastIndexOf "/")))
|
||||
(otherwise (joinPath dir dirOrFile)))]
|
||||
(cond
|
||||
((sys.FileSystem.isDirectory dirOrFile)
|
||||
(chooseFileInDir openFile allowNew dirOrFile))
|
||||
(true
|
||||
(openFile dirOrFile)))))))
|
||||
|
||||
// This has to be a macro so it can return from tryLoadConfig
|
||||
// TODO this macro should use gensym
|
||||
(defMacro trySpawnSync [command args options onError]
|
||||
@@ -134,24 +19,140 @@
|
||||
(,onError "result status is null from $command ${args}: $result.stdout $result.stderr")
|
||||
null)))))
|
||||
|
||||
(function :Void showCompileError [errorMessage]
|
||||
(ifLet [compileErrors (R.distinctMatches
|
||||
(R.group
|
||||
(R.namedGroup "file"
|
||||
(R.repeat (R.oneOf R.anyLetter R.anyDigit (R.escape "/")) 1) // filename
|
||||
(R.escape ".kiss:")
|
||||
(R.repeat R.anyDigit 1) // line
|
||||
(R.escape ":")
|
||||
(R.optional
|
||||
(R.group
|
||||
(R.repeat R.anyDigit 1) // column
|
||||
(R.escape ":"))))
|
||||
(R.repeat R.anyChar 1))
|
||||
errorMessage)]
|
||||
{
|
||||
(Vscode.window.showErrorMessage errorMessage)
|
||||
(awaitLet [chosen (quickPickMap (for match compileErrors =>match.match match))]
|
||||
(Vscode.window.showErrorMessage chosen.match)
|
||||
(executeCommand "workbench.action.quickOpen" (substr (chosen.namedGroup "file") 0 -1)))
|
||||
}
|
||||
(Vscode.window.showErrorMessage errorMessage)))
|
||||
(#unless test
|
||||
/**
|
||||
* Aliases
|
||||
*/
|
||||
|
||||
// output
|
||||
(defAlias &call infoMessage Vscode.window.showInformationMessage)
|
||||
(defAlias &call warningMessage Vscode.window.showWarningMessage)
|
||||
(defAlias &call errorMessage Vscode.window.showErrorMessage)
|
||||
|
||||
// input
|
||||
(defAlias &call inputBox Vscode.window.showInputBox)
|
||||
(defAlias &call _quickPick Vscode.window.showQuickPick)
|
||||
|
||||
(function quickPickItem [label &opt description]
|
||||
(object
|
||||
label label
|
||||
description description
|
||||
detail null
|
||||
picked null
|
||||
alwaysShow null))
|
||||
|
||||
(function quickPick [:Array<String> strings]
|
||||
(awaitLet [chosenItem (_quickPick (for string strings (quickPickItem string)))]
|
||||
(when chosenItem chosenItem.label)))
|
||||
|
||||
// thanks https://stackoverflow.com/a/69842249
|
||||
(function autoSuggestPick [:Array<String> strings]
|
||||
(new js.lib.Promise
|
||||
->[resolve reject] (let [qp (Vscode.window.createQuickPick)
|
||||
:Array<Dynamic> items (for string strings (quickPickItem string))]
|
||||
(set qp.items items)
|
||||
(qp.onDidChangeValue
|
||||
->v (unlessLet [(Some _) (indexOf strings v)]
|
||||
(set qp.items (concat [(quickPickItem v)] items))))
|
||||
(qp.onDidAccept
|
||||
->_ {
|
||||
(resolve .label (first qp.activeItems))
|
||||
(qp.hide)
|
||||
})
|
||||
(qp.show))))
|
||||
|
||||
(function :js.lib.Promise.Thenable<Dynamic> quickPickMap [:Map<String,Dynamic> stringMap]
|
||||
(awaitLet [chosenItem (_quickPick (for =>key value stringMap (quickPickItem key (Std.string value))))]
|
||||
(when chosenItem (dictGet stringMap chosenItem.label))))
|
||||
|
||||
(defAlias &call openDialog Vscode.window.showOpenDialog)
|
||||
|
||||
// commands
|
||||
(defAlias &call executeCommand Vscode.commands.executeCommand)
|
||||
(function repeatCommand [command times]
|
||||
(let [iteration
|
||||
->[&opt _] (executeCommand command)
|
||||
&mut promise
|
||||
(iteration)]
|
||||
(doFor i (range (- times 1))
|
||||
(set promise (promise.then iteration)))
|
||||
promise))
|
||||
|
||||
(defMacro awaitCommands [commandsAndArgs &builder b &body body]
|
||||
(let [commandsAndArgs
|
||||
(if (isListExp commandsAndArgs)
|
||||
(.copy (expList commandsAndArgs))
|
||||
(throw (CompileError.fromExp commandsAndArgs "First argument to awaitCommands should be a list of commands with optional argument arrays")))
|
||||
bindings []]
|
||||
(while commandsAndArgs
|
||||
(bindings.push (b.symbol "_"))
|
||||
(let [nextCommand (commandsAndArgs.shift)]
|
||||
(bindings.push (b.callSymbol "executeCommand"
|
||||
(concat [nextCommand] (if (and commandsAndArgs (isListExp (first commandsAndArgs))) (expList (commandsAndArgs.shift)) []))))))
|
||||
`(awaitLet ,bindings ,@body)))
|
||||
|
||||
// Other
|
||||
|
||||
(defAlias &call showTextDocument Vscode.window.showTextDocument)
|
||||
(defAlias &call openTextDocument Vscode.workspace.openTextDocument)
|
||||
|
||||
// Macros for implementing commands in Kiss
|
||||
|
||||
(defMacro withValueOrInputBox [v &body body]
|
||||
`{
|
||||
(if ,v
|
||||
{,@body}
|
||||
(awaitLet [,v (inputBox)]
|
||||
,@body))
|
||||
null
|
||||
})
|
||||
|
||||
(defMacro withValueOrQuickPick [v options &body body]
|
||||
`(if ,v
|
||||
{,@body}
|
||||
(awaitLet [,v (quickPick ,options)]
|
||||
,@body)))
|
||||
|
||||
(defMacro withValueOrQuickPickMap [v options &body body]
|
||||
`(if ,v
|
||||
{,@body}
|
||||
(awaitLet [,v (quickPickMap ,options)]
|
||||
,@body)))
|
||||
|
||||
(function :Void chooseFileInDir [:String->Void openFile :Bool allowNew &opt :String dir]
|
||||
(withValueOrInputBox dir
|
||||
(set dir (dir.replace "\\" "/"))
|
||||
(when (dir.endsWith "/") (set dir (substr dir 0 -1)))
|
||||
(awaitLet [dirOrFile ((if allowNew autoSuggestPick quickPick) (concat [".."] (sys.FileSystem.readDirectory dir)))]
|
||||
(let [dirOrFile
|
||||
(case dirOrFile
|
||||
(".."
|
||||
(substr dir 0 (dir.lastIndexOf "/")))
|
||||
(otherwise (joinPath dir dirOrFile)))]
|
||||
(cond
|
||||
((sys.FileSystem.isDirectory dirOrFile)
|
||||
(chooseFileInDir openFile allowNew dirOrFile))
|
||||
(true
|
||||
(openFile dirOrFile)))))))
|
||||
|
||||
(function :Void showCompileError [errorMessage]
|
||||
(ifLet [compileErrors (R.distinctMatches
|
||||
(R.group
|
||||
(R.namedGroup "file"
|
||||
(R.repeat (R.oneOf R.anyLetter R.anyDigit (R.escape "/")) 1) // filename
|
||||
(R.escape ".kiss:")
|
||||
(R.repeat R.anyDigit 1) // line
|
||||
(R.escape ":")
|
||||
(R.optional
|
||||
(R.group
|
||||
(R.repeat R.anyDigit 1) // column
|
||||
(R.escape ":"))))
|
||||
(R.repeat R.anyChar 1))
|
||||
errorMessage)]
|
||||
{
|
||||
(Vscode.window.showErrorMessage errorMessage)
|
||||
(awaitLet [chosen (quickPickMap (for match compileErrors =>match.match match))]
|
||||
(Vscode.window.showErrorMessage chosen.match)
|
||||
(executeCommand "workbench.action.quickOpen" (substr (chosen.namedGroup "file") 0 -1)))
|
||||
}
|
||||
(Vscode.window.showErrorMessage errorMessage))))
|
||||
@@ -1,4 +1,4 @@
|
||||
#! /bin/bash
|
||||
|
||||
# Run the build without -D test first, to make sure it works that way too:
|
||||
haxe build.hxml && haxe -D test build.hxml -cmd "node bin/extension.js"
|
||||
echo "!test" && haxe build.hxml && echo "test" && haxe -D test build.hxml -cmd "node bin/extension.js"
|
||||
Reference in New Issue
Block a user