├── .gitignore ├── .travis.yml ├── .vscode ├── settings.json └── tasks.json ├── .vscodeignore ├── CONTRIBUTORS ├── COPYRIGHT.txt ├── LICENSE ├── README.md ├── apps ├── erlang_ls │ ├── .project │ ├── .settings │ │ ├── org.eclipse.core.resources.prefs │ │ ├── org.erlide.core.prefs │ │ └── org.erlide.model.prefs │ ├── README.md │ ├── rebar.config │ ├── src │ │ ├── erlang_ls.app.src │ │ ├── erlang_ls.erl │ │ ├── erlang_ls_app.erl │ │ └── erlang_ls_sup.erl │ └── test │ │ └── session_data.erl ├── lsp_server │ ├── .project │ ├── .settings │ │ ├── org.eclipse.core.resources.prefs │ │ ├── org.erlide.core.prefs │ │ └── org.erlide.model.prefs │ ├── README.md │ ├── include │ │ └── .keep │ ├── priv │ │ └── .keep │ ├── rebar.config │ ├── src │ │ ├── cancellable_worker.erl │ │ ├── jsonrpc.erl │ │ ├── lsp_client.erl │ │ ├── lsp_data.erl │ │ ├── lsp_server.app.src │ │ ├── lsp_server.erl │ │ ├── lsp_server_app.erl │ │ ├── lsp_server_sup.erl │ │ └── lsp_utils.erl │ └── test │ │ ├── .keep │ │ └── cancellable_worker_tests.erl └── sourcer │ ├── .project │ ├── .settings │ ├── org.eclipse.core.resources.prefs │ ├── org.erlide.core.prefs │ └── org.erlide.model.prefs │ ├── README.md │ ├── data │ └── test_unicode.erl │ ├── include │ ├── .keep │ ├── debug.hrl │ ├── sourcer_model.hrl │ ├── sourcer_open.hrl │ ├── sourcer_parse.hrl │ ├── sourcer_scanner_server.hrl │ └── sourcer_search.hrl │ ├── priv │ ├── .keep │ ├── sourcer_db.yaml │ ├── test_rebar.config │ └── test_rebar.config.script │ ├── rebar.config │ ├── src │ ├── sourcer.app.src │ ├── sourcer.erl │ ├── sourcer_analyse.erl │ ├── sourcer_db.erl │ ├── sourcer_dump.erl │ ├── sourcer_externals.erl │ ├── sourcer_indent.erl │ ├── sourcer_layout.erl │ ├── sourcer_lsp.erl │ ├── sourcer_model.erl │ ├── sourcer_operations.erl │ ├── sourcer_parse.erl │ ├── sourcer_parse_util.erl │ ├── sourcer_project.erl │ ├── sourcer_rebar_config.erl │ ├── sourcer_scan.erl │ └── sourcer_util.erl │ ├── src2 │ ├── sourcer_comment.erl │ ├── sourcer_content_assist.erl │ ├── sourcer_doc_server.erl │ ├── sourcer_doc_util.erl │ ├── sourcer_edoc.erl │ ├── sourcer_edoc_doc_provider.erl │ ├── sourcer_model.erl │ ├── sourcer_module.erl │ ├── sourcer_np.erl │ ├── sourcer_np_records.erl │ ├── sourcer_np_util.erl │ ├── sourcer_open.erl │ ├── sourcer_otp_doc.erl │ ├── sourcer_otp_xml_doc_provider.erl │ ├── sourcer_parse.erl │ ├── sourcer_parse_exprs.erl │ ├── sourcer_scan_model.erl │ ├── sourcer_scan_util.erl │ ├── sourcer_scanner.erl │ ├── sourcer_scanner_server.erl │ ├── sourcer_search.erl │ ├── sourcer_search_server.erl │ ├── sourcer_text.erl │ ├── sourcer_types.erl │ └── sourcer_xref.erl │ ├── test │ ├── indent_data │ │ ├── comments │ │ ├── comprehensions │ │ ├── errors │ │ ├── exprs │ │ ├── funcs │ │ ├── highlight │ │ ├── icr │ │ ├── macros │ │ ├── records │ │ ├── terms │ │ ├── try_catch │ │ └── type_specs │ ├── operations_data │ │ ├── aaa.erl │ │ ├── aaa.hrl │ │ └── bbb.erl │ ├── parser_model_tests_data │ ├── sourcer_analyse_tests.erl │ ├── sourcer_db_tests.erl │ ├── sourcer_indent_tests.erl │ ├── sourcer_model_tests.erl │ ├── sourcer_operations_tests.erl │ ├── sourcer_parse_tests.erl │ ├── sourcer_parse_util_tests.erl │ ├── sourcer_scan_tests.erl │ └── sourcer_util_tests.erl │ └── test2 │ ├── sourcer_indent_tests.erl │ ├── sourcer_open_tests.erl │ ├── sourcer_parse_tests.erl │ ├── sourcer_scan_model_tests.erl │ ├── sourcer_scanner_tests.erl │ └── sourcer_search_tests.erl ├── rebar.config ├── rebar.config.script ├── rebar.lock ├── rebar3 └── sourcer.code-workspace /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | erl_crash.dump 3 | *.refs 4 | *.scan 5 | tmp/ 6 | erlang_ls 7 | 8 | *.crashdump 9 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: erlang 2 | otp_release: 3 | - 20.0 4 | install: 5 | - echo "skip 'rebar get-deps'" 6 | script: 7 | - chmod u+x rebar3 8 | - ./rebar3 do compile,eunit 9 | - ./rebar3 coveralls send 10 | - ./rebar3 xref || true 11 | - echo wget http://download.erlide.org/tools/otp_20.0.plt 12 | - echo mv otp_20.0.plt .rebar/sourcer_20.0_plt 13 | - echo ./rebar3 dialyze 14 | 15 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | // Place your settings in this file to overwrite default and user settings. 2 | { 3 | "files.exclude": { 4 | "_build": true 5 | }, 6 | "search.exclude": { 7 | "_build": true 8 | }, 9 | "workbench.colorCustomizations": { 10 | "activityBar.background": "#352D0F", 11 | "titleBar.activeBackground": "#4A4015", 12 | "titleBar.activeForeground": "#FCFBF5" 13 | } 14 | } -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | // Available variables which can be used inside of strings. 2 | // ${workspaceRoot}: the root folder of the team 3 | // ${file}: the current opened file 4 | // ${fileBasename}: the current opened file's basename 5 | // ${fileDirname}: the current opened file's dirname 6 | // ${fileExtname}: the current opened file's extension 7 | // ${cwd}: the current working directory of the spawned process 8 | 9 | // A task runner that calls a custom npm script that compiles the extension. 10 | { 11 | "version": "0.1.0", 12 | 13 | // we want to run npm 14 | "command": "npm", 15 | 16 | // the command is a shell script 17 | "isShellCommand": true, 18 | 19 | // show the output window only if unrecognized errors occur. 20 | "showOutput": "silent", 21 | 22 | // we run the custom script "compile" as defined in package.json 23 | "args": ["run", "compile", "--loglevel", "silent"], 24 | 25 | // The tsc compiler is started in watching mode 26 | "isBackground": true, 27 | 28 | // use the standard tsc in watch mode problem matcher to find compile problems in the output. 29 | "problemMatcher": "$tsc-watch" 30 | } -------------------------------------------------------------------------------- /.vscodeignore: -------------------------------------------------------------------------------- 1 | .vscode/** 2 | .gitignore 3 | erl_crash.dump 4 | .settings/** 5 | _build/** 6 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Many thanks to our contributors (in chronological order): 2 | 3 | Vlad Dumitrescu 4 | Jakob Cederlund 5 | Dan Gudmunsson 6 | Ilya Kharpov 7 | -------------------------------------------------------------------------------- /COPYRIGHT.txt: -------------------------------------------------------------------------------- 1 | %%% Copyright 2015-2016 *name* 2 | %%% 3 | %%% Licensed under the Apache License, Version 2.0 (the "License"); 4 | %%% you may not use this file except in compliance with the License. 5 | %%% You may obtain a copy of the License at 6 | %%% 7 | %%% http://www.apache.org/licenses/LICENSE-2.0 8 | %%% 9 | %%% Unless required by applicable law or agreed to in writing, software 10 | %%% distributed under the License is distributed on an "AS IS" BASIS, 11 | %%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | %%% See the License for the specific language governing permissions and 13 | %%% limitations under the License. 14 | %%% -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Sourcer - language services for IDEs 2 | 3 | > This is a new incarnation of the sourcer project, the old code is still available on the `legacy` branch. 4 | 5 | *Sourcer* aims to provide: 6 | 7 | - a generic language server implementation `lsp_server` 8 | - Erlang support for the above `erlang_ls` 9 | - Erlang language services library `sourcer` 10 | 11 | ## Generic language server `lsp_server` 12 | 13 | The generic language server uses a TCP connection to talk LSP with clients. It encodes/decodes the messages and delegates the actual work to a language specific server, using cancelable worker processes. It also supports making requests to the client. 14 | 15 | ## Erlang server `erlang_ls` 16 | 17 | This is the "real" server, connecting the generic and specific parts and an adapter from LSP to the 'sourcer' data format (see below) and back. 18 | 19 | ### Supported Options 20 | 21 | - --help, -h, undefined, Shows help; 22 | - --dump, -d, string, Dump sourcer db for file; 23 | - --port, -p, integer, LSP server port; 24 | - --verbose, -v, integer, Verbosity level; 25 | - --indent, -i, string, Indent file(s) and exit; 26 | - --config, N/A, string, Configuration file. 27 | 28 | 29 | ### Configuration 30 | 31 | Configuration file contains property list. 32 | 33 | Currently we only support these keys: 34 | 35 | - `indent` - controls indentation parameters. 36 | 37 | Example: 38 | 39 | ```erlang 40 | {indent, [{indentW, 2}]}. 41 | 42 | ``` 43 | 44 | 45 | 46 | ## Language services library `sourcer` 47 | 48 | The actual work is done by this application. It is meant to be LSP-agnostic so that it can be used in other contexts and tools. 49 | 50 | An own parser (largely based on the legacy 'sourcer' code, but simpler) processes the source code and produces a ctags-like database containing information about all interesting code entities. The database should be distributed, in the sense that libraries should be able to provide the data about their own code (produced at build time). 51 | 52 | Query facilities are provided so that the information in the database is presented in a way that the LSP expects. 53 | -------------------------------------------------------------------------------- /apps/erlang_ls/.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | erlang_ls 4 | 5 | 6 | 7 | 8 | 9 | org.erlide.core.erlbuilder 10 | 11 | 12 | 13 | 14 | 15 | org.erlide.core.erlnature 16 | 17 | 18 | -------------------------------------------------------------------------------- /apps/erlang_ls/.settings/org.eclipse.core.resources.prefs: -------------------------------------------------------------------------------- 1 | eclipse.preferences.version=1 2 | encoding/=UTF-8 3 | -------------------------------------------------------------------------------- /apps/erlang_ls/.settings/org.erlide.core.prefs: -------------------------------------------------------------------------------- 1 | backend_version=19.0 2 | eclipse.preferences.version=1 3 | external_includes= 4 | external_modules= 5 | include_dirs=include; 6 | output_dir=ebin 7 | source_dirs=src; 8 | -------------------------------------------------------------------------------- /apps/erlang_ls/.settings/org.erlide.model.prefs: -------------------------------------------------------------------------------- 1 | builderData=INTERNAL|compile|clean|test| 2 | configType=INTERNAL 3 | eclipse.preferences.version=1 4 | -------------------------------------------------------------------------------- /apps/erlang_ls/README.md: -------------------------------------------------------------------------------- 1 | erlang_ls 2 | ===== 3 | 4 | An OTP application 5 | 6 | Build 7 | ----- 8 | 9 | $ rebar3 compile 10 | -------------------------------------------------------------------------------- /apps/erlang_ls/rebar.config: -------------------------------------------------------------------------------- 1 | {require_otp_vsn, "20.*"}. 2 | 3 | {erl_opts, [ 4 | warn_deprecated_function, 5 | warn_export_all, 6 | warn_export_vars, 7 | warn_obsolete_guard, 8 | warn_shadow_vars, 9 | warn_unused_function, 10 | warn_unused_import, 11 | warn_unused_record, 12 | warn_unused_vars, 13 | 14 | nowarnings_as_errors 15 | %warnings_as_errors 16 | ]}. 17 | 18 | {deps, [ 19 | {getopt, "1.0.1"}, 20 | sourcer, 21 | lsp_server 22 | ]}. 23 | 24 | {plugins, [ 25 | rebar_covertool 26 | ]}. 27 | 28 | -------------------------------------------------------------------------------- /apps/erlang_ls/src/erlang_ls.app.src: -------------------------------------------------------------------------------- 1 | {application, erlang_ls, 2 | [ 3 | {description, "An OTP application"} 4 | , {vsn, "0.2.0"} 5 | , {registered, []} 6 | , {mod, { erlang_ls_app, []}} 7 | , {applications, [ 8 | kernel, stdlib, sourcer, lsp_server 9 | ]} 10 | , {env,[]} 11 | , {modules, []} 12 | 13 | ,{contributors, ["Vlad Dumitrescu"]} 14 | ,{licenses, ["Apache 2.0"]} 15 | ,{links, [{"Github", "https://github.com/erlang/sourcer"}]} 16 | ]}. 17 | -------------------------------------------------------------------------------- /apps/erlang_ls/src/erlang_ls.erl: -------------------------------------------------------------------------------- 1 | -module(erlang_ls). 2 | 3 | -export([main/1]). 4 | 5 | -define(DEFAULT_TRANSPORT, tcp). 6 | -define(DEFAULT_PORT, 9000). 7 | 8 | main(Args) -> 9 | case getopt:parse(cli_options(), Args) of 10 | {ok, {Opts, Other}} -> 11 | OptsMap = maps:from_list(proplists:unfold(Opts)), 12 | run(OptsMap, Other); 13 | _Err -> 14 | io:format("Error: ~p~n", [_Err]), 15 | getopt:usage(cli_options(), "lsp_server") 16 | end. 17 | 18 | cli_options() -> 19 | [ 20 | {help, $h, "help", undefined, "Show this help"}, 21 | {dump, $d, "dump", string, "Dump sourcer db for file or project"}, 22 | {format, undefined, "fmt", {atom, raw}, "Format for the dump (default: raw)"}, 23 | {out, undefined, "out", {string, standard_io}, "Destination file for the dump (default: standard_io)"}, 24 | {transport,$t, "transport",{atom, tcp}, "Transport layer for communication (default: tcp, stdio)"}, 25 | {port, $p, "port", integer, "LSP server port"}, 26 | {verbose, $v, "verbose", integer, "Verbosity level"}, 27 | {indent, $i, "indent", string, "Indent file(s) and exit"}, 28 | {stdout, undefined, "stdout", {boolean, false}, "Output to stdout instead of in place"}, 29 | {config, undefined, "config", string, "Configuration file"} 30 | ]. 31 | 32 | run(Opts, Other) -> 33 | Verbose = maps:get(verbose, Opts, 0), 34 | Config = maybe_load_config(maps:get(config, Opts, undefined), Verbose), 35 | case Opts of 36 | #{help := _} -> 37 | getopt:usage(cli_options(), "erlang_ls", "", [ 38 | {"", ""}, 39 | {"Start LS:", "'erlang_ls -P '"}, 40 | {"Indent :", "'erlang_ls -i '"}, 41 | {"Dump :", "'erlang_ls -d -fmt -out '"} 42 | ]), 43 | erlang:halt(0); 44 | #{dump:=DumpFile, format:=Fmt, out:=Out} -> 45 | Out1 = case Out of 46 | "standard_io" -> 47 | standard_io; 48 | _ -> 49 | Out 50 | end, 51 | sourcer_dump:dump(DumpFile, Fmt, Out1); 52 | #{indent := Indent, stdout := Stdout} -> 53 | IndentConfig = proplists:get_value(indent, Config, []), 54 | indent([Indent|Other], IndentConfig, Stdout, Verbose); 55 | _ -> 56 | ServerConfig = proplists:get_value(server, Config, []), 57 | start_server(Opts, ServerConfig) 58 | end. 59 | 60 | start_server(Opts, Config) -> 61 | Transport = maps:get(transport, Opts, proplists:get_value(transport, Config, ?DEFAULT_TRANSPORT)), 62 | 63 | ok = application:load(lsp_server), 64 | ok = application:set_env(lsp_server, transport, Transport), 65 | case Transport of 66 | tcp -> 67 | Port = maps:get(port, Opts, proplists:get_value(port, Config, ?DEFAULT_PORT)), 68 | ok = application:set_env(lsp_server, port, Port); 69 | _ -> 70 | ok 71 | end, 72 | ok = application:set_env(lsp_server, backend, sourcer), 73 | 74 | case application:ensure_all_started(lsp_server, permanent) of 75 | {ok, _R} -> 76 | receive stop -> ok end, 77 | ok; 78 | _Err -> 79 | io:format("Startup error: ~p~n", [_Err]), 80 | ok 81 | end. 82 | 83 | maybe_load_config(undefined, _Verbose) -> 84 | []; 85 | maybe_load_config(File, Verbose) -> 86 | case file:consult(File) of 87 | {ok, Config} -> 88 | Config; 89 | {error, Reason} -> 90 | io:format("Error loading config file: ~ts~n", [File]), 91 | Verbose > 0 andalso io:format("Reason ~p~n", [Reason]), 92 | erlang:halt(1) 93 | end. 94 | 95 | indent([File|Files], Config, Stdout, Verbose) -> 96 | Output = output(Stdout, File), 97 | try case file:read_file(File) of 98 | {ok, BinSrc} -> 99 | Enc = encoding(BinSrc), 100 | Src = unicode:characters_to_list(BinSrc, Enc), 101 | {ST,Indented} = timer:tc(fun() -> sourcer_indent:all(Src, Config) end), 102 | ok = Output(unicode:characters_to_binary(Indented, utf8, Enc)), 103 | Verbose > 0 andalso io:format(standard_error, "Indent: ~.6wms ~s~n", [ST div 1000, File]), 104 | indent(Files, Config, Stdout, Verbose); 105 | {error, Error} -> 106 | Str = io_lib:format("Could not read file: ~ts\n Reason: ~p~n", [File, Error]), 107 | throw({error,Str}) 108 | end 109 | catch throw:{error, Desc} -> 110 | io:format(standard_error, "~ts", [Desc]), 111 | erlang:halt(1); 112 | error:What -> 113 | io:format(standard_error, "Error could not indent file: ~ts\n", [File]), 114 | Verbose > 0 andalso io:format(standard_error, "Error ~p~n", [What]), 115 | Verbose > 1 andalso io:format(standard_error, "Stacktrace ~p~n", [erlang:get_stacktrace()]), 116 | erlang:halt(1) 117 | end; 118 | indent([], _, _, _) -> 119 | ok. 120 | 121 | output(false, File) -> 122 | fun(C) -> 123 | file:write_file(File, C) 124 | end; 125 | output(true, _) -> 126 | fun(C) -> 127 | io:format(standard_io, "~s", [C]) 128 | end. 129 | 130 | encoding(Bin) -> 131 | case epp:read_encoding_from_binary(Bin) of 132 | latin1 -> latin1; 133 | _ -> utf8 134 | end. 135 | -------------------------------------------------------------------------------- /apps/erlang_ls/src/erlang_ls_app.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %% @doc erlang_ls public API 3 | %% @end 4 | %%%------------------------------------------------------------------- 5 | 6 | -module(erlang_ls_app). 7 | 8 | -behaviour(application). 9 | 10 | %% Application callbacks 11 | -export([start/2, stop/1]). 12 | 13 | %%==================================================================== 14 | %% API 15 | %%==================================================================== 16 | 17 | start(_StartType, _StartArgs) -> 18 | erlang_ls_sup:start_link(). 19 | 20 | %%-------------------------------------------------------------------- 21 | stop(_State) -> 22 | ok. 23 | 24 | %%==================================================================== 25 | %% Internal functions 26 | %%==================================================================== 27 | -------------------------------------------------------------------------------- /apps/erlang_ls/src/erlang_ls_sup.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %% @doc erlang_ls top level supervisor. 3 | %% @end 4 | %%%------------------------------------------------------------------- 5 | 6 | -module(erlang_ls_sup). 7 | 8 | -behaviour(supervisor). 9 | 10 | %% API 11 | -export([start_link/0]). 12 | 13 | %% Supervisor callbacks 14 | -export([init/1]). 15 | 16 | -define(SERVER, ?MODULE). 17 | 18 | %%==================================================================== 19 | %% API functions 20 | %%==================================================================== 21 | 22 | start_link() -> 23 | supervisor:start_link({local, ?SERVER}, ?MODULE, []). 24 | 25 | %%==================================================================== 26 | %% Supervisor callbacks 27 | %%==================================================================== 28 | 29 | %% Child :: {Id,StartFunc,Restart,Shutdown,Type,Modules} 30 | init([]) -> 31 | {ok, { {one_for_all, 0, 1}, []} }. 32 | 33 | %%==================================================================== 34 | %% Internal functions 35 | %%==================================================================== 36 | -------------------------------------------------------------------------------- /apps/erlang_ls/test/session_data.erl: -------------------------------------------------------------------------------- 1 | -module(session_data). 2 | 3 | -export([ 4 | all_tests/0 5 | ]). 6 | 7 | all_tests() -> 8 | [ 9 | {initialize_request(), initialize_response()} 10 | ]. 11 | 12 | initialize_request() -> 13 | #{capabilities => 14 | #{textDocument => 15 | #{codeAction => #{dynamicRegistration => true}, 16 | codeLens => #{dynamicRegistration => true}, 17 | completion => 18 | #{completionItem => 19 | #{snippetSupport => true}, 20 | dynamicRegistration => true}, 21 | definition => #{dynamicRegistration => true}, 22 | documentHighlight => 23 | #{dynamicRegistration => true}, 24 | documentLink => 25 | #{dynamicRegistration => true}, 26 | documentSymbol => 27 | #{dynamicRegistration => true}, 28 | formatting => #{dynamicRegistration => true}, 29 | hover => #{dynamicRegistration => true}, 30 | onTypeFormatting => 31 | #{dynamicRegistration => true}, 32 | rangeFormatting => 33 | #{dynamicRegistration => true}, 34 | references => #{dynamicRegistration => true}, 35 | rename => #{dynamicRegistration => true}, 36 | signatureHelp => 37 | #{dynamicRegistration => true}, 38 | synchronization => 39 | #{didSave => true, 40 | dynamicRegistration => true, 41 | willSave => true, 42 | willSaveWaitUntil => true}}, 43 | workspace => 44 | #{applyEdit => true, 45 | didChangeConfiguration => 46 | #{dynamicRegistration => false}, 47 | didChangeWatchedFiles => 48 | #{dynamicRegistration => true}, 49 | executeCommand => 50 | #{dynamicRegistration => true}, 51 | symbol => #{dynamicRegistration => true}, 52 | workspaceEdit => 53 | #{documentChanges => true}}}, 54 | processId => 16538, 55 | rootPath => <<"/home/vlad/projects/rebar3">>, 56 | rootUri => <<"file:///home/vlad/projects/rebar3">>, 57 | trace => <<"off">> 58 | }. 59 | 60 | initialize_response() -> 61 | #{capabilities => 62 | #{completionProvider => 63 | #{resolveProvider => true, 64 | triggerCharacters => [<<":">>,<<"?">>,<<"#">>] 65 | }, 66 | definitionProvider => true, 67 | documentHighlightProvider => true, 68 | documentSymbolProvider => true, 69 | hoverProvider => true, 70 | referencesProvider => true, 71 | renameProvider => true, 72 | signatureHelpProvider => #{triggerCharacters => [<<"(">>]}, 73 | textDocumentSync => 1, 74 | workspaceSymbolProvider => true 75 | } 76 | }. 77 | 78 | didChangeConfiguration_notification() -> 79 | #{settings => 80 | #{erlang => 81 | #{erlangPath => <<>>, 82 | runtime => 83 | #{location => 84 | <<"/home/vlad/erlide_tools/20.0">>}, 85 | server => 86 | #{debug => 87 | <<"false">>, 88 | maxNumberOfProblems => 89 | 100}}} 90 | }. 91 | 92 | didOpen_notification() -> 93 | #{textDocument => 94 | #{languageId => <<"erlang">>, 95 | text => 96 | <<"%%% @doc external alias for `rebar_agent' for more convenient\n%%% calls from a shell.\n-module(r3).\n-export([do/1, do/2]).\n-export(['$handle_undefined_function'/2]).\n\n%% @doc alias for `rebar_agent:do/1'\n-spec do(atom()) -> ok | {error, term()}.\ndo(Command) -> rebar_agent:do(Command).\n\n%% @doc alias for `rebar_agent:do/2'\n-spec do(atom(), atom()) -> ok | {error, term()}.\ndo(Namespace, Command) -> rebar_agent:do(Namespace, Command).\n\n%% @private defer to rebar_agent\n'$handle_undefined_function'(Cmd, Args) ->\n rebar_agent:'$handle_undefined_function'(Cmd, Args).\n">>, 97 | uri => 98 | <<"file:///home/vlad/projects/rebar3/src/r3.erl">>, 99 | version => 1} 100 | }. 101 | 102 | documentSymbol_request() -> 103 | #{textDocument => 104 | #{uri => 105 | <<"file:///home/vlad/projects/rebar3/src/r3.erl">>} 106 | }. 107 | 108 | documentSymbol_response() -> 109 | #{ 110 | }. 111 | 112 | hover_request() -> 113 | #{ 114 | position => #{character => 9,line => 16}, 115 | textDocument => 116 | #{uri => 117 | <<"file:///home/vlad/projects/rebar3/src/r3.erl">>} 118 | }. 119 | 120 | hover_response() -> 121 | #{contents => []}. 122 | 123 | -------------------------------------------------------------------------------- /apps/lsp_server/.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | lsp_server 4 | 5 | 6 | 7 | 8 | 9 | org.erlide.core.erlbuilder 10 | 11 | 12 | 13 | 14 | 15 | org.erlide.core.erlnature 16 | 17 | 18 | -------------------------------------------------------------------------------- /apps/lsp_server/.settings/org.eclipse.core.resources.prefs: -------------------------------------------------------------------------------- 1 | eclipse.preferences.version=1 2 | encoding/=UTF-8 3 | -------------------------------------------------------------------------------- /apps/lsp_server/.settings/org.erlide.core.prefs: -------------------------------------------------------------------------------- 1 | backend_version=19.0 2 | eclipse.preferences.version=1 3 | external_includes= 4 | external_modules= 5 | include_dirs=include; 6 | output_dir=ebin 7 | source_dirs=src; 8 | -------------------------------------------------------------------------------- /apps/lsp_server/.settings/org.erlide.model.prefs: -------------------------------------------------------------------------------- 1 | builderData=INTERNAL|compile|clean|test| 2 | configType=INTERNAL 3 | eclipse.preferences.version=1 4 | -------------------------------------------------------------------------------- /apps/lsp_server/README.md: -------------------------------------------------------------------------------- 1 | lsp_server 2 | ===== 3 | 4 | An OTP application 5 | 6 | Build 7 | ----- 8 | 9 | $ rebar3 compile 10 | -------------------------------------------------------------------------------- /apps/lsp_server/include/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erlang/sourcer/27ea9c63998b9e694eb7b654dd05b831b989e69e/apps/lsp_server/include/.keep -------------------------------------------------------------------------------- /apps/lsp_server/priv/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erlang/sourcer/27ea9c63998b9e694eb7b654dd05b831b989e69e/apps/lsp_server/priv/.keep -------------------------------------------------------------------------------- /apps/lsp_server/rebar.config: -------------------------------------------------------------------------------- 1 | {require_otp_vsn, "20.*"}. 2 | 3 | {plugins, [ 4 | rebar_covertool 5 | ]}. 6 | 7 | {deps, [ 8 | {jsx, "2.9.0"} 9 | ]}. 10 | 11 | {erl_opts, [ 12 | warn_deprecated_function, 13 | warn_export_all, 14 | warn_export_vars, 15 | warn_obsolete_guard, 16 | warn_shadow_vars, 17 | warn_unused_function, 18 | warn_unused_import, 19 | warn_unused_record, 20 | warn_unused_vars, 21 | 22 | nowarnings_as_errors 23 | %warnings_as_errors 24 | ]}. 25 | 26 | {erl_first_files, [ 27 | ]}. 28 | 29 | {edoc_opts,[{todo,true}]}. 30 | 31 | {eunit_opts, [ 32 | verbose, 33 | %nowarn_missing_spec, 34 | nowarnings_as_errors, 35 | {report,{eunit_surefire,[{dir,"."}]}} 36 | ]}. 37 | 38 | {eunit_compile_opts, [ 39 | nowarn_missing_spec 40 | ]}. 41 | 42 | {xref_warnings, true}. 43 | {xref_checks, [ 44 | undefined_function_calls, 45 | undefined_functions, 46 | locals_not_used, 47 | % exports_not_used, 48 | deprecated_function_calls, 49 | deprecated_functions 50 | ]}. 51 | 52 | {dialyzer, [ 53 | %% Store PLT locally inside the project in .rebar (Default) 54 | %% {plt_location, local}, 55 | %% Store PLT in custom directory 56 | %% {plt_location, "custom_dir"}, 57 | {warnings, [unmatched_returns, error_handling, unknown]}, 58 | {base_plt_apps, [erts, kernel, stdlib, syntax_tools, tools]} 59 | ]}. 60 | 61 | {cover_export_enabled, true}. 62 | {cover_enabled, true}. 63 | {cover_print_enable, true}. 64 | 65 | {covertool_eunit, {"_build/test/cover/eunit.coverdata", "eunit.coverage.xml"}}. 66 | {covertool_prefix_len, 0}. 67 | 68 | {xref_checks,[ 69 | undefined_function_calls, 70 | undefined_functions, 71 | locals_not_used, 72 | %exports_not_used, 73 | deprecated_function_calls, 74 | deprecated_functions 75 | ]}. 76 | 77 | -------------------------------------------------------------------------------- /apps/lsp_server/src/cancellable_worker.erl: -------------------------------------------------------------------------------- 1 | %%% Implements a worker process that can be canceled and return a partial answers. 2 | 3 | -module(cancellable_worker). 4 | 5 | -behaviour(gen_server). 6 | 7 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). 8 | 9 | %% ==================================================================== 10 | %% API functions 11 | %% ==================================================================== 12 | 13 | -export([ 14 | start/3, 15 | start/5, 16 | cancel/1, 17 | get_current_results/1, 18 | wait/1 19 | ]). 20 | 21 | %% Start the worker. 22 | %% * WorkerFun computes whatever values are required and reports the results back (using the 23 | %% given function parameter). 24 | %% * {chunk, V} reports a partial result (added to the list of previous chunks) 25 | %% * {value, V} reports the whole result; don't report anything more after this. 26 | %% * Reporter sends the formatted result (can send as message, store in database, etc) as a 27 | %% tuple {Status, Value}, where Status may be 'done' or 'canceled', in case the client has use 28 | %% for that information; and Value is returned from WorkerFun. 29 | %% 30 | %% TODO: we should maybe add a "formatting" argument, as the result to be reported might not be 31 | %% a simple list of items; but then we'd need a "merge" operation too, and things get complicated 32 | start(Id, WorkerFun, Reporter) -> 33 | gen_server:start(?MODULE, [Id, WorkerFun, Reporter], []). 34 | 35 | start(Id, Module, Function, Args, Reporter) -> 36 | start(Id, fun() -> apply(Module, Function, Args) end, Reporter). 37 | 38 | %% Return the results computed until the current time. Worker proceeds. 39 | get_current_results(Pid) when is_pid(Pid) -> 40 | gen_server:call(Pid, get_current_results). 41 | 42 | %% Cancels the worker. The current results are reported as usual. 43 | cancel(Pid) when is_pid(Pid) -> 44 | gen_server:cast(Pid, cancel). 45 | 46 | %% Block and wait for slave to die. 47 | wait(Pid) when is_pid(Pid) -> 48 | gen_server:call(Pid, wait). 49 | 50 | %% ==================================================================== 51 | %% Behavioural functions 52 | %% ==================================================================== 53 | -record(state, { 54 | id, 55 | slave = undefined, 56 | results = nothing, 57 | reporter 58 | }). 59 | 60 | init([Id, WorkerFun, Reporter]) -> 61 | Parent = self(), 62 | SlaveReporter = fun(V) -> 63 | gen_server:cast(Parent, {work, V}) 64 | end, 65 | {Slave, _Ref} = spawn_monitor(fun() -> 66 | WorkerFun(SlaveReporter) 67 | end), 68 | State = #state{id=Id, slave=Slave, reporter=Reporter}, 69 | {ok, State}. 70 | 71 | handle_call(get_current_results, _From, State=#state{results={partial, _}=Results}) -> 72 | {reply, {ok, prepare(Results)}, State}; 73 | handle_call(get_current_results, _From, State=#state{results={value, _}=Results}) -> 74 | {reply, {ok, Results}, State}; 75 | handle_call(get_current_results, _From, State=#state{results=nothing}) -> 76 | {reply, {ok, nothing}, State}; 77 | handle_call(wait, _From, State=#state{slave=undefined}) -> 78 | {reply, {ok, nothing}, State}; 79 | handle_call(wait, _From, State) -> 80 | {reply, {ok, nothing}, State}; 81 | handle_call(Request, _From, State) -> 82 | io:format("Unexpected call in cancelable_worker: ~p~n", [Request]), 83 | Reply = {error, {unknown, Request}}, 84 | {reply, Reply, State}. 85 | 86 | handle_cast(cancel, State=#state{slave=Pid}) when is_pid(Pid) -> 87 | exit(Pid, kill), 88 | {noreply, State}; 89 | handle_cast({work, {chunk, V}}, State=#state{results=nothing}) -> 90 | {noreply, State#state{results={partial, [V]}}}; 91 | handle_cast({work, {chunk, V}}, State=#state{results={partial, Results}}) when is_list(Results) -> 92 | {noreply, State#state{results={partial, [V|Results]}}}; 93 | handle_cast({work, {chunk, _}}, State=#state{results={value, _}}) -> 94 | {noreply, State}; 95 | handle_cast({work, {value, V}}, State) -> 96 | {noreply, State#state{results={value, V}}}; 97 | handle_cast(_Msg, State) -> 98 | io:format("Unexpected cast in cancelable_worker: ~p (~p)~n", [_Msg, State]), 99 | {noreply, State}. 100 | 101 | handle_info({'DOWN', _, process, Pid, Reason}, 102 | State=#state{slave=Pid, results=nothing, 103 | reporter=Reporter}) -> 104 | Status = status(Reason), 105 | Reporter({Status, nothing}), 106 | {stop, normal, State#state{slave=undefined}}; 107 | handle_info({'DOWN', _, process, Pid, Reason}, 108 | State=#state{slave=Pid, results=Results, 109 | reporter=Reporter}) -> 110 | Status = status(Reason), 111 | Reporter({Status, prepare(Results)}), 112 | {stop, normal, State#state{slave=undefined}}; 113 | handle_info(_Info, State) -> 114 | io:format("Unexpected message in cancelable_worker: ~p~n~p~n", [_Info, State]), 115 | {noreply, State}. 116 | 117 | terminate(_Reason, _State) -> 118 | ok. 119 | 120 | code_change(_OldVsn, State, _Extra) -> 121 | {ok, State}. 122 | 123 | %% ==================================================================== 124 | %% Internal functions 125 | %% ==================================================================== 126 | 127 | prepare({partial, V}) -> 128 | lists:reverse(V); 129 | prepare({value, V}) -> 130 | V; 131 | prepare(V) -> 132 | V. 133 | 134 | status(Reason) -> 135 | case Reason of 136 | normal -> done; 137 | killed -> canceled 138 | end. -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_client.erl: -------------------------------------------------------------------------------- 1 | %% @author vlad 2 | %% @doc Handle outgoing requests from server to client. 3 | 4 | -module(lsp_client). 5 | 6 | -behaviour(gen_server). 7 | 8 | -export([ 9 | start_link/0, 10 | 11 | show_message/2, 12 | show_message_request/3, 13 | log_message/2, 14 | telemetry_event/1, 15 | publish_diagnostics/2, 16 | register_capability/1, 17 | unregister_capability/1, 18 | apply_edit/1, 19 | 20 | workspaceFolders/0 21 | ]). 22 | 23 | -export([ 24 | init/1, 25 | handle_call/3, 26 | handle_cast/2, 27 | handle_info/2, 28 | terminate/2, 29 | code_change/3 30 | ]). 31 | 32 | -define(SERVER, ?MODULE). 33 | 34 | -record(state, { 35 | crt_id = 0, 36 | pending_requests = [] 37 | }). 38 | 39 | start_link() -> 40 | gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). 41 | 42 | %% client API 43 | 44 | show_message(Type, Msg) -> 45 | gen_server:cast(?SERVER, {show_message, Type, Msg}). 46 | 47 | show_message_request(Type, Msg, Actions) -> 48 | gen_server:call(?SERVER, {show_message_request, Type, Msg, Actions, self()}). 49 | 50 | log_message(Type, Msg) -> 51 | gen_server:cast(?SERVER, {log_message, Type, Msg}). 52 | 53 | telemetry_event(Msg) -> 54 | gen_server:cast(?SERVER, {telemetry_event, Msg}). 55 | 56 | publish_diagnostics(URI, Diagnostics) -> 57 | gen_server:cast(?SERVER, {publish_diagnostics, URI, Diagnostics}). 58 | 59 | register_capability(Args) -> 60 | gen_server:call(?SERVER, {register_capability, Args, self()}). 61 | 62 | unregister_capability(Args) -> 63 | gen_server:call(?SERVER, {unregister_capability, Args, self()}). 64 | 65 | apply_edit(Args) -> 66 | gen_server:call(?SERVER, {apply_edit, Args, self()}). 67 | 68 | workspaceFolders() -> 69 | io:format("FOO\n"), 70 | gen_server:call(?SERVER, {workspaceFolders, self()}). 71 | 72 | %%%%%%%%%%%%%%%%%%%%% 73 | 74 | init([]) -> 75 | process_flag(trap_exit, true), 76 | State = #state{ 77 | }, 78 | {ok, State}. 79 | 80 | handle_call({show_message_request, Type, Msg, Actions, Pid}, _From, 81 | State = #state{pending_requests=Reqs}) -> 82 | Id = State#state.crt_id, 83 | NewState = State#state{ 84 | pending_requests = [{Id, Pid} | Reqs], 85 | crt_id = Id + 1 86 | }, 87 | jsonrpc ! {request, Id, 'window/showMessageRequest', 88 | #{type => Type, 89 | message => unicode:characters_to_binary(Msg), 90 | actions => Actions} 91 | }, 92 | %% TODO 93 | {reply, ok, NewState}; 94 | handle_call({register_capability, Args, Pid}, _From, State = #state{pending_requests=Reqs}) -> 95 | Id = State#state.crt_id, 96 | NewState = State#state{ 97 | pending_requests = [{Id, Pid} | Reqs], 98 | crt_id = Id + 1 99 | }, 100 | jsonrpc ! {request, 'client/register_capability', Args, Pid}, 101 | %% TODO 102 | {reply, ok, NewState}; 103 | handle_call({unregister_capability, Args, Pid}, _From, State = #state{pending_requests=Reqs}) -> 104 | Id = State#state.crt_id, 105 | NewState = State#state{ 106 | pending_requests = [{Id, Pid} | Reqs], 107 | crt_id = Id + 1 108 | }, 109 | jsonrpc ! {request, 'client/unregister_capability', Args, Pid}, 110 | %% TODO 111 | {reply, ok, NewState}; 112 | handle_call({apply_edit, Args, Pid}, _From, State = #state{pending_requests=Reqs}) -> 113 | Id = State#state.crt_id, 114 | NewState = State#state{ 115 | pending_requests = [{Id, Pid} | Reqs], 116 | crt_id = Id + 1 117 | }, 118 | jsonrpc ! {request, 'workspace/applyEdit', Args, Pid}, 119 | %% TODO 120 | {reply, ok, NewState}; 121 | handle_call({workspaceFolders, Pid}, _From, State = #state{pending_requests=Reqs}) -> 122 | Id = State#state.crt_id, 123 | NewState = State#state{ 124 | pending_requests = [{Id, Pid} | Reqs], 125 | crt_id = Id + 1 126 | }, 127 | jsonrpc ! {request, 'workspace/workspaceFolders', Pid}, 128 | %% TODO 129 | {reply, ok, NewState}; 130 | handle_call(Request, From, State) -> 131 | io:format("Unrecognized call from ~w: ~p~n", [From, Request]), 132 | Reply = {error, {unknown, Request}}, 133 | {reply, Reply, State}. 134 | 135 | handle_cast({'shutdown', _Id, _}, State) -> 136 | {noreply, State}; 137 | handle_cast({'exit', _}, State) -> 138 | {stop, State}; 139 | handle_cast({show_message, Type, Msg}, State) -> 140 | jsonrpc ! {notify, 'window/showMessage', 141 | #{type => Type, 142 | message => unicode:characters_to_binary(Msg)}}, 143 | {noreply, State}; 144 | handle_cast({log_message, Type, Msg}, State) -> 145 | jsonrpc ! {notify, 'window/logMessage', 146 | #{type => Type, 147 | message => unicode:characters_to_binary(Msg)}}, 148 | {noreply, State}; 149 | handle_cast({telemetry_event, Msg}, State) -> 150 | jsonrpc ! {notify, 'telemetry/event', Msg}, 151 | {noreply, State}; 152 | handle_cast({publish_diagnostics, URI, Diagnostics}, State) -> 153 | jsonrpc ! {notify, 'textDocument/publishDiagnostics', 154 | #{uri => URI, 155 | diagnostics => Diagnostics}}, 156 | {noreply, State}; 157 | handle_cast(Other, State) -> 158 | io:format("Unrecognized cast: ~p~n", [Other]), 159 | {noreply, State}. 160 | 161 | handle_info({'$reply', Id, Msg}, State) -> 162 | case lists:keytake(Id, 1, State#state.pending_requests) of 163 | false -> 164 | {noreply, State}; 165 | {value, {Id, Pid}, Rest} -> 166 | Pid ! Msg, 167 | {noreply, State#state{pending_requests=Rest}} 168 | end; 169 | handle_info(Info, State) -> 170 | io:format("Unrecognized message: ~p~n", [Info]), 171 | {noreply, State}. 172 | 173 | terminate(_Reason, _State) -> 174 | ok. 175 | 176 | code_change(_OldVsn, State, _Extra) -> 177 | {ok, State}. 178 | 179 | reply(Connection, Id, Answer) -> 180 | Connection ! {reply, Id, Answer}. 181 | 182 | -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_data.erl: -------------------------------------------------------------------------------- 1 | -module(lsp_data). 2 | 3 | -export([ 4 | encode/2, 5 | decode/2, 6 | get_data/1, 7 | get_value/2 8 | ]). 9 | 10 | -export_type([ 11 | initialize_params/0 12 | ]). 13 | 14 | -type initialize_params() :: #{ 15 | 'processId' := integer()|'null', 16 | 'rootPath' => string(), 17 | 'rootUri' := string()|'null', 18 | 'initializationOptions' => any(), 19 | 'capabilities' => any(), 20 | 'trace' => 'off'|'messages'|'verbose' 21 | }. 22 | 23 | encode(Key, Data) -> 24 | {Key, Value} = lists:keyfind(Key, 1, get_data(Data)), 25 | Value. 26 | 27 | decode(Key, Data) -> 28 | {Value, Key} = lists:keyfind(Key, 2, get_data(Data)), 29 | Value. 30 | 31 | encode_server_capabilities(Input) -> 32 | try 33 | Caps = maps:get(capabilities, Input), 34 | Sync = maps:get(textDocumentSync, Caps, none), 35 | Input#{capabilities=>Caps#{textDocumentSync=>lsp_data:encode(Sync, sync)}} 36 | catch _:_ -> 37 | Input 38 | end. 39 | 40 | get_data(sync) -> 41 | sync_data(); 42 | get_data(symbol) -> 43 | symbol_data(); 44 | get_data(completion) -> 45 | completion_data(). 46 | 47 | sync_data() -> 48 | [ 49 | {none, 0}, 50 | {full, 1}, 51 | {incremental, 2} 52 | ]. 53 | 54 | symbol_data() -> 55 | [ 56 | {file, 1}, 57 | {module, 2}, 58 | %{namespace, 3}, 59 | %{package, 4}, 60 | {type, 5}, % class 61 | %{method, 6}, 62 | {macro, 7}, % property 63 | {field, 8}, 64 | %{constructor, 9}, 65 | %{enum, 10}, 66 | %{interface, 11}, 67 | {function, 12}, 68 | {variable, 13}, 69 | {constant, 14}, 70 | {string, 15}, 71 | {number, 16}, 72 | {boolean, 17} 73 | %{array, 18} 74 | ]. 75 | 76 | completion_data() -> 77 | [ 78 | {text, 1}, 79 | {macro, 2}, % method 80 | {function, 3}, 81 | %{constructor, 4}, 82 | {field, 5}, 83 | {variable, 6}, 84 | {type, 7}, % class 85 | %{interface, 8}, 86 | {module, 9}, 87 | %{property, 10}, 88 | %{unit, 11}, 89 | {value, 12}, 90 | %{enum, 13}, 91 | {keyword, 14}, 92 | {snippet, 15}, 93 | %{color, 16}, 94 | {file, 17} 95 | %{reference, 18} 96 | ]. 97 | 98 | get_value(Data, Key) when is_map(Data), is_atom(Key) -> 99 | maps:get(Key, Data, null); 100 | get_value(Data, []) when is_map(Data) -> 101 | null; 102 | get_value(Data, [Key]) when is_map(Data) -> 103 | get_value(Data, Key); 104 | get_value(Data, [Key|T]) when is_map(Data) -> 105 | case get_value(Data, Key) of 106 | null -> 107 | null; 108 | MoreData -> 109 | get_value(MoreData, T) 110 | end; 111 | get_value(_Data, _Key) -> 112 | null. 113 | 114 | -ifdef(TEST). 115 | 116 | -include_lib("eunit/include/eunit.hrl"). 117 | 118 | get_value_test_() -> 119 | [ 120 | ?_assertEqual(null, get_value(#{y=>1}, x)), 121 | ?_assertEqual(1, get_value(#{x=>1}, x)), 122 | 123 | ?_assertEqual(null, get_value(#{y=>1}, [])), 124 | 125 | ?_assertEqual(null, get_value(#{y=>1}, [x])), 126 | ?_assertEqual(1, get_value(#{x=>1}, [x])), 127 | 128 | ?_assertEqual(null, get_value(#{y=>1}, [x, y])), 129 | ?_assertEqual(null, get_value(#{x=>1}, [x, y])), 130 | ?_assertEqual(null, get_value(#{x=>#{z=>1}}, [x, y])), 131 | ?_assertEqual(1, get_value(#{x=>#{y=>1}}, [x, y])), 132 | 133 | ?_assertEqual(null, get_value(#{}, x)) 134 | ]. 135 | 136 | encode_test_() -> 137 | [ 138 | ?_assertEqual(0, encode(none, sync)), 139 | ?_assertEqual(1, encode(full, sync)), 140 | ?_assertEqual(17, encode(file, completion)), 141 | ?_assertEqual(17, encode(boolean, symbol)) 142 | ]. 143 | 144 | decode_test_() -> 145 | [ 146 | ?_assertEqual(none, decode(0, sync)), 147 | ?_assertEqual(full, decode(1, sync)), 148 | ?_assertEqual(file, decode(17, completion)), 149 | ?_assertEqual(boolean, decode(17, symbol)) 150 | ]. 151 | 152 | encode_server_capabilities_test_() -> 153 | [ 154 | ?_assertEqual(#{}, encode_server_capabilities(#{})), 155 | ?_assertEqual(#{capabilities=>#{textDocumentSync=>1}}, encode_server_capabilities(#{capabilities=>#{textDocumentSync=>full}})) 156 | ]. 157 | 158 | -endif. 159 | -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_server.app.src: -------------------------------------------------------------------------------- 1 | {application, lsp_server, 2 | [ 3 | {vsn, "0.2.0"} 4 | , {erlide_context, ide} 5 | , {registered, [lsp_server_sup, jsonrpc, lsp_server, lsp_client]} 6 | , {applications, [kernel, stdlib, jsx, getopt]} 7 | , {env, []} 8 | , {mod, {lsp_server_app, []}} 9 | , {contributors, ["Vlad Dumitrescu"]} 10 | , {licenses, ["Apache 2.0"]} 11 | , {links, [{"Github", "https://github.com/erlang/sourcer"}]} 12 | ]}. 13 | -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_server.erl: -------------------------------------------------------------------------------- 1 | %%% @author vlad 2 | %%% @doc Handle LSP messages by dispatching (asynchronously) 3 | %%% to a provided handler module. 4 | 5 | -module(lsp_server). 6 | 7 | -behaviour(gen_server). 8 | 9 | -export([ 10 | start_link/1 11 | ]). 12 | 13 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). 14 | 15 | -define(SERVER, ?MODULE). 16 | 17 | start_link(Mod) -> 18 | gen_server:start_link({local, ?SERVER}, ?MODULE, [Mod], []). 19 | 20 | %%%%%%%%%%%%%%%%%%%%% 21 | 22 | -record(state, { 23 | stopped = true, 24 | pending_requests = [], 25 | user_module = sourcer, 26 | user_state 27 | %% TODO: user_state can be big, do we want to keep send it back and forth 28 | %% for each request?? If we want async workers, it can't be completely 29 | %% avoided, I think 30 | %% -->> workers should get only parts of the state that are relevant for 31 | %% the operation, for example only the current document data 32 | %% (unless it's a worskpace operation) 33 | }). 34 | 35 | %%-define(DEBUG, true). 36 | 37 | -ifdef(DEBUG). 38 | -define(DEBUG(F, A), io:format(F, A)). 39 | -else. 40 | -define(DEBUG(F, A), ok). 41 | -endif. 42 | 43 | init([Mod]) -> 44 | State = #state{ 45 | user_module = Mod 46 | }, 47 | {ok, State}. 48 | 49 | handle_call({'initialize', Id, Params}, 50 | _From, State=#state{user_module = Mod}) -> 51 | ?DEBUG("REQ ~p: ~p:: ~p~n", [Id, 'initialize', Params]), 52 | {Reply, NewUserState} = Mod:initialize(Params), 53 | reply(Id, Reply), 54 | {reply, error, State#state{user_state=NewUserState, stopped=false}}; 55 | handle_call({_Method, Id, _Params}, 56 | _From, State=#state{user_module = Mod, stopped=true}) -> 57 | reply(Id, Mod:error(server_not_initialized, "Server was stopped")), 58 | {reply, error, State}; 59 | handle_call({Method, Id, Params}, 60 | _From, State=#state{user_module = Mod, pending_requests=Reqs}) -> 61 | ?DEBUG("REQ ~p: ~p:: ~p~n", [Id, Method, Params]), 62 | Pid = start_worker(Id, Method, Params, State), 63 | NewReqs = [{Id, Pid}|Reqs], 64 | {noreply, State#state{pending_requests=NewReqs}}; 65 | handle_call(Request, _From, State) -> 66 | ?DEBUG("Unrecognized request: ~p~n", [Request]), 67 | Reply = {error, {unknown, Request}}, 68 | {reply, Reply, State}. 69 | 70 | handle_cast({'exit', _}, State) -> 71 | ?DEBUG("NTF: ~p::~n", ['exit']), 72 | {stop, State}; 73 | handle_cast({Method, Params}, State=#state{stopped=true}) -> 74 | ?DEBUG("NTF: ignored ~p:: ~p~n", [Method, Params]), 75 | {noreply, State}; 76 | handle_cast({'$/cancelRequest', #{id := Id}}, State) -> 77 | ?DEBUG("NTF: ~p:: ~p~n", ['$/cancelRequest', Id]), 78 | NewState = cancel_worker(Id, State), 79 | {noreply, NewState}; 80 | handle_cast({Method, Params}, State=#state{user_module=Mod}) -> 81 | ?DEBUG("NTF: ~p:: ~p~n", [Method, Params]), 82 | %% run in-process to keep the ordering of received messages 83 | Exps = Mod:module_info(exports), 84 | NewState = case lists:member({Method, 2}, Exps) of 85 | true -> 86 | try 87 | Mod:Method(State#state.user_state, Params) 88 | catch _:E -> 89 | ?DEBUG("####################~nERROR: ~p~n(~p:~p ~p) ~n-- ~p~n", [E, Mod, Method, Params, erlang:get_stacktrace()]), 90 | State#state.user_state 91 | end; 92 | false -> 93 | io:format("Unsupported notification: ~p~n", [Method]), 94 | State#state.user_state 95 | end, 96 | {noreply, State#state{user_state=NewState}}; 97 | handle_cast(Other, State) -> 98 | io:format("Unrecognized notification: ~p~n", [Other]), 99 | {noreply, State}. 100 | 101 | handle_info(_Info, State) -> 102 | io:format("Unrecognized message: ~p~n", [_Info]), 103 | {noreply, State}. 104 | 105 | terminate(_Reason, _State) -> 106 | ok. 107 | 108 | code_change(_OldVsn, State, _Extra) -> 109 | {ok, State}. 110 | 111 | reply(Id, Answer) -> 112 | ?DEBUG("ANS ~p:: ~p~n", [Id, Answer]), 113 | jsonrpc ! {reply, Id, Answer}, 114 | ok. 115 | 116 | cancel_worker(Id, #state{pending_requests=Reqs}=State) -> 117 | case lists:keytake(Id, 1, Reqs) of 118 | {value, {Id, Pid}, NewReqs} -> 119 | cancellable_worker:cancel(Pid), 120 | State#state{pending_requests=NewReqs}; 121 | false -> 122 | State 123 | end. 124 | 125 | start_worker(Id, Method, Params, State) -> 126 | UserState = State#state.user_state, 127 | Mod = State#state.user_module, 128 | Work = fun(Reporter) -> 129 | Exps = Mod:module_info(exports), 130 | case lists:member({Method, 3}, Exps) of 131 | true -> 132 | try 133 | sourcer:Method(UserState, Params, Reporter) 134 | catch _:E -> 135 | ?DEBUG("####################~nERROR: ~p~n(~p:~p ~p) ~n-- ~p~n", [E, Mod, Method, Params, erlang:get_stacktrace()]), 136 | % Mod:default_answer(Method) 137 | null 138 | end; 139 | false -> 140 | io:format("Unsupported request: ~p~n", [Method]) 141 | %% ?? 142 | end 143 | end, 144 | Replier = fun({_, nothing}) -> 145 | Answer = null, %Mod:default_answer(Method), 146 | reply(Id, Answer); 147 | ({_, Answer}) -> 148 | reply(Id, Answer) 149 | end, 150 | {ok, Pid} = cancellable_worker:start(Id, Work, Replier), 151 | Pid. 152 | 153 | -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_server_app.erl: -------------------------------------------------------------------------------- 1 | -module(lsp_server_app). 2 | 3 | -behaviour(application). 4 | -export([ 5 | start/2, 6 | stop/1 7 | ]). 8 | 9 | start(_Type, _StartArgs) -> 10 | case lsp_server_sup:start_link() of 11 | {ok, Pid} -> 12 | {ok, Pid}; 13 | Other -> 14 | {error, Other} 15 | end. 16 | 17 | stop(_State) -> 18 | init:stop(), 19 | ok. 20 | 21 | -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_server_sup.erl: -------------------------------------------------------------------------------- 1 | -module(lsp_server_sup). 2 | 3 | -behaviour(supervisor). 4 | 5 | -export([start_link/0]). 6 | 7 | -export([init/1]). 8 | 9 | start_link() -> 10 | R = supervisor:start_link({local, ?MODULE}, ?MODULE, []), 11 | R. 12 | 13 | init([]) -> 14 | Children = children(), 15 | %% no supervisor restarts 16 | {ok, {{one_for_one, 0, 1}, Children}}. 17 | 18 | children() -> 19 | {ok, Transport} = application:get_env(lsp_server, transport), 20 | Args = case Transport of 21 | stdio -> 22 | stdio; 23 | tcp -> 24 | {ok, Port} = application:get_env(lsp_server, port), 25 | {tcp, Port} 26 | end, 27 | {ok, Backend} = application:get_env(lsp_server, backend), 28 | JsonRpc = {jsonrpc, {jsonrpc, start_link, [Args, lsp_server, lsp_client]}, 29 | permanent, 60000, worker, [jsonrpc]}, 30 | IdeServer = {lsp_server, {lsp_server, start_link, [Backend]}, 31 | permanent, 60000, worker, [lsp_server]}, 32 | IdeClient = {lsp_client, {lsp_client, start_link, []}, 33 | permanent, 60000, worker, [lsp_client]}, 34 | [ 35 | JsonRpc, IdeServer, IdeClient 36 | ]. 37 | 38 | -------------------------------------------------------------------------------- /apps/lsp_server/src/lsp_utils.erl: -------------------------------------------------------------------------------- 1 | -module(lsp_utils). 2 | 3 | -export([ 4 | position/2, 5 | range/2, 6 | range/4 7 | ]). 8 | 9 | position(L, C) -> 10 | #{line=>L, character=>C}. 11 | 12 | range(P1, P2) -> 13 | #{start=>P1, 'end'=>P2}. 14 | 15 | range(L1, C1, L2, C2) -> 16 | range(position(L1, C1), position(L2, C2)). 17 | 18 | -------------------------------------------------------------------------------- /apps/lsp_server/test/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erlang/sourcer/27ea9c63998b9e694eb7b654dd05b831b989e69e/apps/lsp_server/test/.keep -------------------------------------------------------------------------------- /apps/lsp_server/test/cancellable_worker_tests.erl: -------------------------------------------------------------------------------- 1 | -module(cancellable_worker_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | nothing_test() -> 6 | W = fun(_Rp) -> 7 | receive after 500 -> ok end 8 | end, 9 | S = self(), 10 | R = fun(A) -> S ! A end, 11 | {ok, _P} = cancellable_worker:start(1, W, R), 12 | Value = receive X -> X after 4000 -> timeout end, 13 | Expect = {done, nothing}, 14 | ?assertEqual(Expect, Value). 15 | 16 | nothing_cancel_test() -> 17 | W = fun(_Rp) -> 18 | idle_worker(10) 19 | end, 20 | S = self(), 21 | R = fun(A) -> S ! A end, 22 | {ok, P} = cancellable_worker:start(1, W, R), 23 | receive after 1000 -> ok end, 24 | cancellable_worker:cancel(P), 25 | Value = receive X -> X after 4000 -> timeout end, 26 | Expect = {canceled, nothing}, 27 | ?assertEqual(Expect, Value). 28 | 29 | idle_worker(N) when N=<0 -> 30 | ok; 31 | idle_worker(N) -> 32 | receive 33 | after 300 -> 34 | idle_worker(N-1) 35 | end. 36 | 37 | something_test() -> 38 | W = fun(Rp) -> 39 | busy_worker(4, Rp) 40 | end, 41 | S = self(), 42 | R = fun(A) -> S ! A end, 43 | {ok, _P} = cancellable_worker:start(1, W, R), 44 | Value = receive X -> X after 4000 -> timeout end, 45 | Expect = {done, [{4},{3},{2},{1}]}, 46 | ?assertEqual(Expect, Value). 47 | 48 | something_cancel_test() -> 49 | W = fun(Rp) -> 50 | busy_worker(10, Rp) 51 | end, 52 | S = self(), 53 | R = fun(A) -> S ! A end, 54 | {ok, P} = cancellable_worker:start(1, W, R), 55 | receive after 1000 -> ok end, 56 | cancellable_worker:cancel(P), 57 | Value = receive X -> X after 4000 -> timeout end, 58 | Expect = {canceled, [{10},{9},{8}]}, 59 | ?assertEqual(Expect, Value). 60 | 61 | busy_worker(N, _R) when N=<0 -> 62 | ok; 63 | busy_worker(N, R) -> 64 | receive 65 | after 300 -> 66 | R({chunk, {N}}), 67 | busy_worker(N-1, R) 68 | end. 69 | 70 | check_test() -> 71 | W = fun(Rp) -> 72 | busy_worker(10, Rp) 73 | end, 74 | S = self(), 75 | R = fun(A) -> S ! A end, 76 | {ok, P} = cancellable_worker:start(1, W, R), 77 | {ok, X0} = cancellable_worker:get_current_results(P), 78 | receive after 1000 -> ok end, 79 | {ok, X1} = cancellable_worker:get_current_results(P), 80 | receive after 1000 -> ok end, 81 | {ok, X2} = cancellable_worker:get_current_results(P), 82 | Expect = {nothing, [{10},{9},{8}],[{10},{9},{8},{7},{6},{5}]}, 83 | ?assertEqual(Expect, {X0, X1, X2}). 84 | 85 | value_test() -> 86 | W = fun(Rp) -> 87 | receive after 10 -> ok end, 88 | Rp({value, overwritten}), 89 | Rp({value, excellent}), 90 | Rp({chunk, ignored}) 91 | end, 92 | S = self(), 93 | R = fun(A) -> S ! A end, 94 | {ok, _P} = cancellable_worker:start(1, W, R), 95 | Value = receive X -> X after 4000 -> timeout end, 96 | Expect = {done, excellent}, 97 | ?assertEqual(Expect, Value). 98 | 99 | -------------------------------------------------------------------------------- /apps/sourcer/.project: -------------------------------------------------------------------------------- 1 | 2 | 3 | sourcer 4 | 5 | 6 | 7 | 8 | 9 | org.erlide.core.erlbuilder 10 | 11 | 12 | 13 | 14 | 15 | org.erlide.core.erlnature 16 | 17 | 18 | -------------------------------------------------------------------------------- /apps/sourcer/.settings/org.eclipse.core.resources.prefs: -------------------------------------------------------------------------------- 1 | eclipse.preferences.version=1 2 | encoding/=UTF-8 3 | -------------------------------------------------------------------------------- /apps/sourcer/.settings/org.erlide.core.prefs: -------------------------------------------------------------------------------- 1 | backend_version=19.0 2 | eclipse.preferences.version=1 3 | external_includes= 4 | external_modules= 5 | include_dirs=include; 6 | output_dir=ebin 7 | source_dirs=src; 8 | -------------------------------------------------------------------------------- /apps/sourcer/.settings/org.erlide.model.prefs: -------------------------------------------------------------------------------- 1 | builderData=INTERNAL|compile|clean|test| 2 | configType=INTERNAL 3 | eclipse.preferences.version=1 4 | -------------------------------------------------------------------------------- /apps/sourcer/README.md: -------------------------------------------------------------------------------- 1 | # sourcer: erlang language services 2 | 3 | IDEs offer sophisticated services to users of programming languages. This library implements such services for Elang, so that clients (IDEs, editors) don't need to. Microsoft's Language Server Protocol is offering a standard way for clients and servers to talk about the code being edited and we follow their APIs. This aplication should not be dependent on LSP specifics, but in the beginning it will be easier to follow those APIs closely. 4 | 5 | There are two components that are meant to be loosely coupled. One is a parser that reads code and produces a ctags-like database with all interesting elemnts in the source code and their attributes. The other is a query engine that can traverse the database and gather information relative to specific services (like completion, references or documentation). 6 | 7 | From our experience with [erlide](http://erlide.org), we know that the user experience is much better if the database is readily available even for large libraries (especially the OTP). So a goal is to allow libraries to provide their own chunks of the database, built off-line. 8 | 9 | ## Build 10 | 11 | $ rebar3 compile 12 | 13 | # Notes, issues & thoughts 14 | 15 | - I'd like to use file offsets alongside line and column numbers, but there is a problem when caching the information: the line endings. On Windows, the offsets will be shifted with one position for each line, compared with Linux and OSX. So maybe it is better to let the client care about the conversion. 16 | 17 | - We only load library apps on demand. There might be exceptions like `_checkouts` which should be considered as part of the project. For legacy (non-rebar) projects, it may be needed to specify this somehow, since we can't rely on conventions. 18 | 19 | 20 | -------------------------------------------------------------------------------- /apps/sourcer/data/test_unicode.erl: -------------------------------------------------------------------------------- 1 | -module(test_unicode). 2 | %% 3 | %% 外国語の勉強と教え 4 | %% Изучение и обучение иностранных языков 5 | %% 語文教學・语文教学 6 | %% Enseñanza y estudio de idiomas 7 | %% Изучаване и Преподаване на Чужди Езипи 8 | %% ქართული ენის შესწავლა და სწავლება 9 | %% 'læŋɡwidʒ 'lɘr:niŋ ænd 'ti:ʃiŋ 10 | %% Lus kawm thaib qhia 11 | %% Ngôn Ngữ, Sự học, 12 | %% ‭‫ללמוד וללמד את השֵפה 13 | %% L'enseignement et l'étude des langues 14 | %% 㜊㞕㧍㒟㦮 㐀㛲㭘㒟 15 | %% Nauka języków obcych 16 | %% Γλωσσική Εκμὰθηση και Διδασκαλία 17 | %% ‭‫ﺗﺪﺭﯾﺲ ﻭ ﯾﺎﺩﮔﯿﺮﯼ ﺯﺑﺎﻥ 18 | %% Sprachlernen und -lehren 19 | %% ‭‫ﺗﻌﻠ‫ُّ‪‫ﻢ ﻭﺗﺪﺭﻳﺲ ﺍﻟﻌﺮﺑﻴﺔ 20 | %% เรียนและสอนภาษา 21 | 22 | %% 23 | start("謀", $為) -> 24 | " 25 | 外国語の勉強と教え 26 | Изучение и обучение иностранных языков 27 | 語文教學・语文教学 28 | Enseñanza y estudio de idiomas 29 | Изучаване и Преподаване на Чужди Езипи 30 | ქართული ენის შესწავლა და სწავლება 31 | 'læŋɡwidʒ 'lɘr:niŋ ænd 'ti:ʃiŋ 32 | Lus kawm thaib qhia 33 | Ngôn Ngữ, Sự học, 34 | ‭‫ללמוד וללמד את השֵפה 35 | L'enseignement et l'étude des langues 36 | 㜊㞕㧍㒟㦮 㐀㛲㭘㒟 37 | Nauka języków obcych 38 | Γλωσσική Εκμὰθηση και Διδασκαλία 39 | ‭‫ﺗﺪﺭﯾﺲ ﻭ ﯾﺎﺩﮔﯿﺮﯼ ﺯﺑﺎﻥ 40 | Sprachlernen und -lehren 41 | ‭‫ﺗﻌﻠ‫ُّ‪‫ﻢ ﻭﺗﺪﺭﻳﺲ ﺍﻟﻌﺮﺑﻴﺔ 42 | เรียนและสอนภาษา 43 | ", 44 | $為, 45 | ok. 46 | 47 | stop()-> 48 | ok. 49 | 50 | -------------------------------------------------------------------------------- /apps/sourcer/include/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erlang/sourcer/27ea9c63998b9e694eb7b654dd05b831b989e69e/apps/sourcer/include/.keep -------------------------------------------------------------------------------- /apps/sourcer/include/debug.hrl: -------------------------------------------------------------------------------- 1 | %-define(Debug(T), sourcer_log:erlangLog(?MODULE, ?LINE, finest, T)). 2 | %-define(DebugStack(T), sourcer_log:erlangLogStack(?MODULE, ?LINE, finest, T)). 3 | %-define(Info(T), sourcer_log:erlangLog(?MODULE, ?LINE, info, T)). 4 | 5 | -ifdef(DEBUG). 6 | -define(D(F, T), io:format(F, T)). 7 | -define(D(T), ?D("~p\n", [{??T, ?MODULE, ?LINE, T}])). 8 | -else. 9 | -define(D(F,T), ok). 10 | -define(D(T), ok). 11 | -endif. 12 | 13 | 14 | -------------------------------------------------------------------------------- /apps/sourcer/include/sourcer_model.hrl: -------------------------------------------------------------------------------- 1 | %%% TODO the specs in this file are not fully implemented yet! 2 | 3 | -type path() :: string(). 4 | -type project_ref() :: path(). 5 | %% Projects are either OTP applications/libraries, or 6 | %% they have a configuration file at their root location 7 | %% (default is 'rebar.config') that specifies where sources 8 | %% and dependencies are to be found. 9 | %% Rebar3-style local deps are recognized: 10 | %% apps/ | lib/ | libs/ | deps/ | _build/*/lib/ 11 | -record(project, { 12 | name :: string(), 13 | location :: path(), 14 | includes = ["include"] :: [path()], 15 | sources = ["src"] :: [path()], 16 | deps = [] :: [project_ref()], 17 | options = [] :: [any()] 18 | }). 19 | -type project() :: #project{}. 20 | 21 | -type pos() :: {non_neg_integer(), non_neg_integer()}. 22 | -type range() :: {pos(), pos()} | 'none'. 23 | -type location() :: #{'uri' := uri(), 'range' := range()}. 24 | 25 | -type key() :: {'module',atom()} | 26 | {'function',atom(),integer()} | 27 | {'macro',atom(),integer(),Index::integer()} | 28 | {'type',atom(),integer()} | 29 | {'include', atom()} | 30 | {'include_lib', atom()} | 31 | {'record', atom()}. 32 | -type ctx() :: [key()]. 33 | 34 | -record(def, { 35 | ctx :: ctx(), 36 | name_range = 'none' :: range(), 37 | info = #{} :: #{_=>_} 38 | }). 39 | -type def() :: #def{}. 40 | 41 | -record(ref, { 42 | ctx :: ctx(), 43 | range :: range() 44 | }). 45 | -type ref() :: #ref{}. 46 | 47 | -type uri() :: binary(). 48 | -type text() :: unicode:chardata(). 49 | 50 | -record(model, { 51 | vsn = 1 :: non_neg_integer(), 52 | defs = [] :: [def()], 53 | refs = [] :: [ref()] 54 | }). 55 | 56 | -type model() :: #model{} | 'empty' | 'not_available'. 57 | 58 | -record(db_entry, { 59 | model :: model(), 60 | text :: binary() | path(), 61 | includes = [] :: [path()] 62 | }). 63 | -type db_entry() :: #db_entry{}. 64 | -record(db, { 65 | models = dict:new() :: dict:dict(uri(), db_entry()), 66 | deps = digraph:new([acyclic]) :: digraph:graph() 67 | }). 68 | -type db() :: #db{}. 69 | 70 | -record(workspace, { 71 | projects = [] :: [project()] 72 | }). 73 | -type workspace() :: #workspace{}. 74 | 75 | 76 | %%%%%%%%%%%%%%%%%%%%%%%%%% 77 | 78 | -define(LPAR, '('). 79 | -define(RPAR, ')'). 80 | -define(LCURL, '{'). 81 | -define(RCURL, '}'). 82 | 83 | -define(k(X), {X,_,_,_}). 84 | -define(v(X), {_,_,_,X}). 85 | -------------------------------------------------------------------------------- /apps/sourcer/include/sourcer_open.hrl: -------------------------------------------------------------------------------- 1 | 2 | -record(open_context, {externalModules=[], 3 | externalIncludes=[], 4 | pathVars=[], 5 | extraSourcePaths=[], 6 | imports=[]}). 7 | -------------------------------------------------------------------------------- /apps/sourcer/include/sourcer_parse.hrl: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /apps/sourcer/include/sourcer_scanner_server.hrl: -------------------------------------------------------------------------------- 1 | -record(module, {name, 2 | lines = [], % [{Length, String}] 3 | tokens = [] % [{Length, [Token]}] 4 | }). 5 | -------------------------------------------------------------------------------- /apps/sourcer/include/sourcer_search.hrl: -------------------------------------------------------------------------------- 1 | %% Description: References used for searches, generated by sourcer_noparse 2 | %% Author: jakob (jakobce at g mail dot com) 3 | %% Created: 21 mar 2010 4 | 5 | -record(ref, { 6 | data, 7 | offset, 8 | length, 9 | function, 10 | arity, 11 | clause, 12 | sub_clause 13 | }). 14 | 15 | -record(external_call, { 16 | module, 17 | function, 18 | arity 19 | }). 20 | -record(local_call, { 21 | function, 22 | arity 23 | }). 24 | -record(function_def, { 25 | function, 26 | arity 27 | }). 28 | -record(function_def_mod, { 29 | module, 30 | function, 31 | arity 32 | }). 33 | -record(include_ref, { 34 | filename 35 | }). 36 | -record(macro_ref, { 37 | name 38 | }). 39 | -record(record_ref, { 40 | name 41 | }). 42 | -record(macro_def, { 43 | name 44 | }). 45 | -record(parse_record, { 46 | name 47 | }). 48 | -record(type_ref, { 49 | module, 50 | type 51 | }). 52 | -record(type_def, { 53 | type 54 | }). 55 | -record(module_def, { 56 | name 57 | }). 58 | -record(var_def, { 59 | name 60 | }). 61 | -record(var_ref, { 62 | name 63 | }). 64 | -record(var_pattern, { 65 | vardefref, 66 | function, 67 | arity, 68 | clause 69 | }). 70 | -record(record_field_def, { 71 | record, 72 | name 73 | }). 74 | -record(record_field_ref, { 75 | record, 76 | name 77 | }). 78 | -------------------------------------------------------------------------------- /apps/sourcer/priv/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erlang/sourcer/27ea9c63998b9e694eb7b654dd05b831b989e69e/apps/sourcer/priv/.keep -------------------------------------------------------------------------------- /apps/sourcer/priv/sourcer_db.yaml: -------------------------------------------------------------------------------- 1 | 2 | - _ALL_: 3 | - id: $id 4 | - parent: $id 5 | - range: range 6 | - name_range: range 7 | - application: # from .app ? 8 | # parent is root 9 | - * name: string 10 | - is_library: boolean 11 | - file: 12 | # parent is root (if none) 13 | - * location: uri 14 | - application: $id # not a parent, just a relation 15 | - is_library: boolean 16 | - module: 17 | # parent is file 18 | - * name: atom 19 | - comments: [string] 20 | - documentation: uri 21 | - include: 22 | # parent is file, module or ifdef 23 | - * target: file 24 | - is_library: boolean 25 | - function: 26 | # parent is file, module or ifdef 27 | - * name: atom 28 | - * arity: integer 29 | - is_exported: boolean 30 | - comments: [string] 31 | - documentation: uri 32 | - spec: spec 33 | - type: 34 | # parent is file, module or ifdef 35 | - * name: atom 36 | - * arity: integer 37 | - is_exported: boolean 38 | - comments: [string] 39 | - documentation: uri 40 | - macro: 41 | # parent is file, module or ifdef 42 | - * name: atom 43 | - * arity: integer 44 | - record: 45 | # parent is file, module or ifdef 46 | - * name: atom 47 | - field: 48 | # parent is record 49 | - * name: string 50 | - type: term 51 | - clause: # scope for variables 52 | # parent is function 53 | - signature: term 54 | - anonfun: # scope for variables 55 | # parent is clause or anonfun 56 | - variable: 57 | # parent is clause or anonfun 58 | - * name: atom 59 | - ifdef: 60 | # parent is file, module or ifdef 61 | - * condition: macro 62 | - if_range: range 63 | - else_range: range 64 | 65 | --- 66 | 67 | - reference: 68 | - key: $id 69 | - range: range 70 | - kind: name of file|module|function|macro|record|type|field|variable 71 | # needed? can be deduced by checking $id 72 | -------------------------------------------------------------------------------- /apps/sourcer/priv/test_rebar.config: -------------------------------------------------------------------------------- 1 | {require_otp_vsn, "20.*"}. 2 | 3 | {deps, [ 4 | foo 5 | ]}. 6 | 7 | 8 | -------------------------------------------------------------------------------- /apps/sourcer/priv/test_rebar.config.script: -------------------------------------------------------------------------------- 1 | CONFIG++[{hej,SCRIPT}]. 2 | -------------------------------------------------------------------------------- /apps/sourcer/rebar.config: -------------------------------------------------------------------------------- 1 | {require_otp_vsn, "20.*"}. 2 | 3 | {plugins, [ 4 | rebar_covertool 5 | ]}. 6 | 7 | {deps, [ 8 | %{rebar, {git, "git://github.com/erlang/rebar3.git", {tag, "3.5.0"}}} 9 | ]}. 10 | 11 | {erl_opts, [ 12 | warn_deprecated_function, 13 | warn_export_all, 14 | warn_export_vars, 15 | warn_obsolete_guard, 16 | warn_shadow_vars, 17 | warn_unused_function, 18 | warn_unused_import, 19 | warn_unused_record, 20 | warn_unused_vars, 21 | 22 | nowarnings_as_errors 23 | %warnings_as_errors 24 | ]}. 25 | {erl_first_files, [ 26 | ]}. 27 | 28 | {edoc_opts,[{todo,true}]}. 29 | 30 | {eunit_opts, [ 31 | verbose, 32 | %nowarn_missing_spec, 33 | nowarnings_as_errors, 34 | {report,{eunit_surefire,[{dir,"."}]}} 35 | ]}. 36 | {eunit_compile_opts, [ 37 | nowarn_missing_spec 38 | ]}. 39 | 40 | {cover_export_enabled, true}. 41 | {cover_enabled, true}. 42 | {cover_print_enable, true}. 43 | 44 | {covertool_eunit, {"_build/test/cover/eunit.coverdata", "eunit.coverage.xml"}}. 45 | {covertool_prefix_len, 0}. 46 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer.app.src: -------------------------------------------------------------------------------- 1 | {application, sourcer, 2 | [ 3 | {vsn, "0.2.0"} 4 | , {erlide_context, ide} 5 | , {registered, []} 6 | , {applications, [kernel, stdlib, syntax_tools]} 7 | , {env, []} 8 | , {contributors, ["Vlad Dumitrescu"]} 9 | , {licenses, ["Apache 2.0"]} 10 | , {links, [{"Github", "https://github.com/erlang/sourcer"}]} 11 | ]} 12 | . 13 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_db.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_db). 2 | 3 | -export([ 4 | new/0, 5 | add_files/2, 6 | get_model/2, 7 | 8 | get_defs/3, 9 | get_refs/3, 10 | get_info/3, 11 | get_text/3, 12 | get_completion/3, 13 | 14 | open_file/3, 15 | update_file/3, 16 | close_file/2, 17 | get_text/2, 18 | process_watched/2, 19 | 20 | resolve_file_reference/3, 21 | 22 | symbols/2, 23 | 24 | get_uri/2 25 | ]). 26 | 27 | %%-define(DEBUG, true). 28 | -include("debug.hrl"). 29 | 30 | -include("sourcer_model.hrl"). 31 | 32 | new() -> 33 | #db{}. 34 | 35 | add_entry(Uri, Text, IsOpen, DB) -> 36 | %?D({Uri, Text, IsOpen}), 37 | Text1 = unicode:characters_to_list(Text), 38 | Model = sourcer_analyse:analyse_text(Text1), 39 | MyText = case IsOpen of 40 | true -> 41 | Text; 42 | false -> 43 | Text %sourcer_util:uri_to_path(Uri) 44 | end, 45 | Entry = #db_entry{ 46 | model = Model, 47 | text = MyText 48 | }, 49 | Models = DB#db.models, 50 | % TODO retrieved includes 51 | NewModels = dict:store(Uri, Entry, Models), 52 | digraph:add_vertex(DB#db.deps, Uri), 53 | DB#db{models=NewModels}. 54 | 55 | remove_entry(Uri, DB) -> 56 | Models = DB#db.models, 57 | Entry = dict:fetch(Uri, Models), 58 | digraph:del_vertex(DB#db.deps, Uri), 59 | NewModels = dict:erase(Uri, Models), 60 | DB#db{models=NewModels}. 61 | 62 | update_entry(Uri, Text, IsOpen, DB) -> 63 | add_entry(Uri, Text, IsOpen, DB). 64 | 65 | -spec get_model(uri(), db()) -> model(). 66 | get_model(Uri, DB) -> 67 | Models = DB#db.models, 68 | Entry = dict:fetch(Uri, Models), 69 | Entry#db_entry.model. 70 | 71 | get_defs(_Uri, _Pos, _DB) -> 72 | []. 73 | 74 | get_refs(_Uri, _Pos, _DB) -> 75 | []. 76 | 77 | get_info(_Uri, _Key, _DB) -> 78 | % (docs, spec, children keys [both defs and refs?]) 79 | []. 80 | 81 | get_text(Uri, DB) -> 82 | Models = DB#db.models, 83 | case dict:find(Uri, Models) of 84 | {ok, Entry} -> 85 | Entry#db_entry.text; 86 | Error -> 87 | ?D({uri_not_found, Uri, dict:fetch_keys(Models)}), 88 | <<>> 89 | end. 90 | 91 | get_text(_Uri, _Range, _DB) -> 92 | []. 93 | 94 | get_completion(_Uri, _Pos, _DB) -> 95 | % get the crt line's text and scan it, so we don't have to save tokens? 96 | []. 97 | 98 | %% @doc Return the full path of Target when referenced from Source 99 | resolve_file_reference(_Source, Target, _DB) -> 100 | 101 | Target. 102 | 103 | %%%%%%%%%%%%%%%%%% 104 | 105 | open_file(DB, Uri, Text) -> 106 | ?D({open, Uri}), 107 | add_entry(Uri, Text, true, DB). 108 | 109 | update_file(DB, Uri, [#{text:=Text}]) -> 110 | ?D({change, Uri}), 111 | update_entry(Uri, Text, true, DB); 112 | update_file(DB, _Uri, _Changes) -> 113 | DB. 114 | 115 | close_file(DB, Uri) -> 116 | ?D({close, Uri}), 117 | Models = DB#db.models, 118 | Entry = dict:fetch(Uri, Models), 119 | NewModels = dict:store(Uri, 120 | Entry#db_entry{text=sourcer_util:uri_to_path(Uri)}, 121 | Models), 122 | DB#db{models=NewModels}. 123 | 124 | process_watched(DB, Changes) -> 125 | DB. 126 | 127 | process_watched_1(#{uri:=Uri, type:=1}, List) -> 128 | %% TODO: start parsing & processing 129 | [Uri|List]; 130 | process_watched_1(#{uri:=_Uri, type:=2}, List) -> 131 | %% TODO: start parsing & processing 132 | List; 133 | process_watched_1(#{uri:=Uri, type:=3}, List) -> 134 | lists:delete(Uri, List). 135 | 136 | add_files(Files, DB) -> 137 | lists:foldl(fun(F, Acc)-> 138 | case dict:find(F, Acc#db.models) of 139 | {ok, _} -> 140 | Acc; 141 | error -> 142 | case file:read_file(sourcer_util:uri_to_path(F)) of 143 | {ok, Txt} -> 144 | add_entry(F, Txt, false, Acc); 145 | _Err -> 146 | ?D({_Err, F}), 147 | Acc 148 | end 149 | end 150 | end, DB, Files). 151 | 152 | symbols(Query, DB) -> 153 | Models = DB#db.models, 154 | %?D(Models), 155 | All = dict:to_list(Models), 156 | ?D(length(All)), 157 | Syms = lists:flatten([spread(K,(V#db_entry.model)#model.defs) 158 | || {K,V}<-All 159 | ]), 160 | ?D(length(Syms)), 161 | Z = lists:flatten([symbol(X, Query) || X<-Syms]), 162 | ?D(length(Z)), 163 | % TODO too long list crashes something with vscode 164 | case length(Z)>200 of 165 | true -> truncate(Z, 200); 166 | false -> Z 167 | end. 168 | 169 | symbol({Uri, #def{ctx=Ctx,name_range=Range}}=_X, Query) -> 170 | Name = sourcer_lsp:print_name(Ctx), 171 | case {Query, string:find(Name, Query)} of 172 | {<<>>, _} -> 173 | [{Name, 5, Uri, Range}]; 174 | {_, nomatch} -> 175 | []; 176 | _ -> 177 | [{Name, 5, Uri, Range}] 178 | end; 179 | symbol(_Y, _) -> 180 | ?D(_Y), 181 | {<<"foo">>, 5, <<"Uri">>, none}. 182 | 183 | spread(K, L) -> 184 | [{K, X} || X<-L]. 185 | 186 | truncate(L, N) -> 187 | truncate(L, N, []). 188 | 189 | truncate(_, 0, R) -> 190 | R; 191 | truncate([H|T], N, R) -> 192 | truncate(T, N-1, [H|R]). 193 | 194 | 195 | get_uri(Key, DB) -> 196 | <<"hello">>. 197 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_dump.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_dump). 2 | 3 | -export([ 4 | dump/3 5 | ]). 6 | 7 | %%-define(DEBUG, true). 8 | -include("debug.hrl"). 9 | 10 | -include("sourcer_model.hrl"). 11 | -include_lib("xmerl/include/xmerl.hrl"). 12 | 13 | 14 | dump(FileOrDir, Fmt, Out) -> 15 | case {filelib:is_dir(FileOrDir),filelib:is_regular(FileOrDir)} of 16 | {true, _} -> 17 | dump_project(FileOrDir, Fmt, Out); 18 | {_, true} -> 19 | dump_files([FileOrDir], Fmt, Out); 20 | _ -> 21 | {error, not_found, FileOrDir} 22 | end. 23 | 24 | dump_project(Dir, Fmt, Out) -> 25 | ?D(Dir), 26 | [Layout] = sourcer_layout:detect_layout(Dir), 27 | ?D(Layout), 28 | {ok, Files1} = file:list_dir(filename:join(Dir, Layout#project.sources)), 29 | {ok, Files2} = file:list_dir(filename:join(Dir, Layout#project.includes)), 30 | AllFiles = [filename:join([Dir, Layout#project.sources, F]) || F<-Files1] 31 | ++ [filename:join([Dir, Layout#project.includes, F]) || F<-Files2], 32 | dump_files(AllFiles, Fmt, Out), 33 | ok. 34 | 35 | dump_files(Files, Fmt, Out) -> 36 | with_file(Out, fun(OutF)-> 37 | case Fmt of 38 | raw -> 39 | dump_raw(Files, OutF); 40 | s101 -> 41 | dump_s101(Files, OutF); 42 | _ -> 43 | ok 44 | end 45 | end). 46 | 47 | with_file(Out, Body) -> 48 | case Out of 49 | standard_io -> 50 | Body(Out); 51 | _ -> 52 | case file:open(Out, [write]) of 53 | {ok, OutF} -> 54 | try 55 | Body(OutF) 56 | after 57 | case Out of 58 | standard_io -> 59 | ok; 60 | _ -> 61 | file:close(OutF) 62 | end 63 | end; 64 | Err -> 65 | Err 66 | end 67 | end. 68 | 69 | dump_raw(Files, Out) -> 70 | DB = sourcer_analyse:merge([analyse_file(F) || F<- Files]), 71 | io:format(Out, "Dump: ~n", []), 72 | case DB of 73 | Model=#model{defs=D, refs=R} -> 74 | C = case io:columns() of {ok, Cc} -> Cc; _ -> 80 end, 75 | io:format(Out, "Definitions:::~n~*p~n-----~n", [C, lists:sort(D)]), 76 | io:format(Out, "References:::~n~*p~n-----~n", [C, lists:sort(R)]), 77 | ok; 78 | Err -> 79 | io:format("Error:: ~p~n", [Err]) 80 | end. 81 | 82 | -define(NL, #xmlText{value=[10]}). 83 | 84 | dump_s101(Files, Out) -> 85 | DB = sourcer_analyse:merge([analyse_file(F) || F<- Files]), 86 | case DB of 87 | Model=#model{defs=D, refs=R} -> 88 | M = get_modules(D), 89 | Data = {data, [{flavor, "org.erlang.erlang"}], [ 90 | ?NL, 91 | {modules, M}, 92 | ?NL, 93 | {dependencies, get_dependencies(M, R)}, 94 | ?NL 95 | ]}, 96 | XML = xmerl:export_simple([?NL,Data], xmerl_xml), 97 | io:format("~s~n", [lists:flatten(XML)]); 98 | Err -> 99 | io:format("~p~n", [Err]) 100 | end. 101 | 102 | get_modules(Defs) -> 103 | lists:flatten([[{module, [{name, io_lib:format("~w", [D#def.ctx])}, {id, "?"},{type, "module"}], []},?NL] || D<-Defs]). 104 | 105 | get_dependencies(Mods, Refs) -> 106 | lists:flatten([[{dependency, [{from, "?"}, {to, io_lib:format("~w", [R#ref.ctx])}, {type, "calls"}], []},?NL] || R<-Refs]). 107 | 108 | scan(D) -> 109 | T = unicode:characters_to_list(D), 110 | {ok, Ts, _} = sourcer_scan:string(T), 111 | sourcer_scan:filter_ws_tokens(Ts). 112 | 113 | 114 | analyse_file(FileName) -> 115 | case file:read_file(FileName) of 116 | {ok, Content} -> 117 | {ST,Tokens} = timer:tc(fun() -> scan(Content) end), 118 | {PT,ParseTree} = timer:tc(fun() -> sourcer_parse:parse(Tokens) end), 119 | {AT, M} = timer:tc(fun() -> sourcer_analyse:analyse(ParseTree) end), 120 | M; 121 | _ -> 122 | {error, FileName} 123 | end. 124 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_layout.erl: -------------------------------------------------------------------------------- 1 | %%% @doc Support the basic discovery of apps 2 | %%% and layout for the project. 3 | -module(sourcer_layout). 4 | 5 | -export([ 6 | detect_layouts/1, 7 | detect_layout/1 8 | ]). 9 | 10 | -include("debug.hrl"). 11 | -include("sourcer_model.hrl"). 12 | 13 | -define(DEFAULT_REBAR_BUILD_DIR, "_build"). 14 | -define(DEFAULT_PROJECT_APP_DIRS, ["apps", "lib", "deps", "libs"]). 15 | -define(DEFAULT_REBAR_CHECKOUTS_DIR, "_checkouts"). 16 | -define(DEFAULT_TEST_DEPS_DIR, "test/lib"). 17 | 18 | %% Assume Dir is root of a project. 19 | detect_layouts(Dirs) -> 20 | lists:flatten([detect_layout(D) || D<-Dirs]). 21 | 22 | detect_layout(Dir) -> 23 | case find_erlide_config(Dir) of 24 | [] -> 25 | find_rebar_config(Dir); 26 | Cfg -> 27 | Cfg 28 | end. 29 | 30 | find_erlide_config(_Dir) -> 31 | []. 32 | 33 | find_rebar_config(Dir) -> 34 | [#project{name=Dir, location=Dir}]. 35 | 36 | %% TODO implement real detection of layout 37 | 38 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_lsp.erl: -------------------------------------------------------------------------------- 1 | %%% @doc Translate to/from sourcer_module and sourcer_db data from/to 2 | %%% the json expected by LSP. 3 | -module(sourcer_lsp). 4 | 5 | -export([ 6 | location/2, 7 | text_edit/2, 8 | hover/1, 9 | hover/2, 10 | print_name/1, 11 | markup_content/2, 12 | completion_item/1, 13 | completion_list/2, 14 | symbol_information/1, 15 | symbol_information/2, 16 | highlight/1, 17 | symbols/2, 18 | references/1, 19 | definition/1 20 | ]). 21 | 22 | %%-define(DEBUG, true). 23 | -include("debug.hrl"). 24 | 25 | -include("sourcer_model.hrl"). 26 | 27 | range(none) -> 28 | null; 29 | range({{L1,C1},{L2,C2}}) -> 30 | #{ 31 | start=>#{line=>L1, character=>C1-1}, 32 | 'end'=>#{line=>L2, character=>C2-1} 33 | }. 34 | 35 | location(Uri, Range) -> 36 | #{uri=>Uri, range=>range(Range)}. 37 | 38 | text_edit(NewText, Range) -> 39 | #{range=>range(Range), 40 | newText=>unicode:characters_to_binary(NewText)}. 41 | 42 | definition(Defs) -> 43 | [location(Uri, Range) || {Uri, #def{name_range=Range}}<-Defs]. 44 | 45 | references(L) -> 46 | Fun = fun({Uri, #ref{range=Y}}) -> location(Uri, Y); 47 | ({Uri, #def{name_range=Y}}) -> location(Uri, Y) 48 | end, 49 | lists:map(Fun, L). 50 | 51 | refdef(Uri, #ref{ctx=Key,range=Range}) -> 52 | #{ 53 | name=>print_name(Key), 54 | kind=>kind(element(1, hd(Key))), 55 | location=>#{ 56 | Uri=>Uri, 57 | range=>range(Range) 58 | } 59 | }; 60 | refdef(Uri, #def{ctx=Key,name_range=Range}) -> 61 | #{ 62 | name=>print_name(Key), 63 | kind=>kind(element(1, hd(Key))), 64 | location=>#{ 65 | Uri=>Uri, 66 | range=>range(Range) 67 | } 68 | }. 69 | 70 | location_refs(Model, Uri) -> 71 | #model{refs=Refs, defs=Defs} = Model, 72 | [ 73 | #{ 74 | Uri=>Uri, 75 | range=>range(Pos) 76 | } 77 | || {Key,Pos} <- Refs++Defs]. 78 | 79 | 80 | print_name(List) when is_list(List) -> 81 | iolist_to_binary([print_name(X)||X<-List]); 82 | print_name(Data) -> 83 | case Data of 84 | {module, M} -> 85 | iolist_to_binary(io_lib:format("~s:", [M])); 86 | {function, F, A} -> 87 | iolist_to_binary(io_lib:format("~w/~w", [F, A])); 88 | {clause, N} -> 89 | iolist_to_binary(io_lib:format("@~w", [N])); 90 | {macro, M, A} -> 91 | case A of 92 | -1 -> 93 | iolist_to_binary(io_lib:format("?~s", [M])); 94 | _ -> 95 | iolist_to_binary(io_lib:format("?~s/~w", [M, A])) 96 | end; 97 | {var, N} -> 98 | iolist_to_binary(io_lib:format("!~s", [N])); 99 | _ -> 100 | iolist_to_binary(io_lib:format("~w", [Data])) 101 | end. 102 | 103 | kind(E) -> 104 | case lists:keyfind(E, 1, lsp_data:get_data(symbol)) of 105 | false -> 106 | 2; 107 | {_, N} -> 108 | N 109 | end. 110 | 111 | hover(Contents) -> 112 | hover(Contents, null). 113 | 114 | hover(Contents, Range) -> 115 | #{ 116 | contents => markup_content(markdown, Contents), 117 | range => Range 118 | }. 119 | 120 | markup_content(Kind, Str) -> 121 | #{ 122 | kind => unicode:characters_to_binary(atom_to_list(Kind)), 123 | value => unicode:characters_to_binary(Str) 124 | }. 125 | 126 | completion_item(Item) -> 127 | %% TODO 128 | #{}. 129 | 130 | completion_list(complete, Items) -> 131 | #{ 132 | isIncomplete => false, 133 | items => [completion_item(X) || X <-Items] 134 | }; 135 | completion_list(_, Items) -> 136 | #{ 137 | isIncomplete => true, 138 | items => [completion_item(X) || X <-Items] 139 | }. 140 | 141 | symbol_information(Uri, #def{ctx=Key, name_range=Range}) -> 142 | %% TODO symbol kind 143 | symbol_information({print_name(Key), 2, Uri, Range}). 144 | 145 | symbol_information({Name, Kind, Uri, Range}=X) -> 146 | #{ 147 | name => unicode:characters_to_binary(Name), 148 | kind => Kind, 149 | location => location(Uri, Range) 150 | }; 151 | symbol_information({Name, Kind, Uri, Range, Container}) -> 152 | #{ 153 | name => unicode:characters_to_binary(Name), 154 | kind => Kind, 155 | location => location(Uri, Range), 156 | containerName => Container 157 | }. 158 | 159 | symbols(Uri, Syms) -> 160 | [ #{ 161 | name => print_name(Key), 162 | kind => 1, 163 | location => location(Uri, Range) 164 | } 165 | || #def{ctx=Key,name_range=Range}<-Syms]. 166 | 167 | highlight(L) when is_list(L) -> 168 | [highlight(X) || X<-L]; 169 | highlight(#ref{range=Range}) -> 170 | #{range=>range(Range), kind=>2}; 171 | highlight(#def{name_range=Range}) -> 172 | #{range=>range(Range), kind=>3}. 173 | 174 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_model.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_model). 2 | 3 | -export([ 4 | load_model/1, 5 | save_model/2, 6 | get_elements_at_pos/2, 7 | print_key/1 8 | ]). 9 | 10 | -include("sourcer_model.hrl"). 11 | 12 | %%-define(DEBUG, true). 13 | -include("debug.hrl"). 14 | 15 | -ifdef(DEBUG). 16 | 17 | load_model(File) -> 18 | {ok, [Model]} = file:consult(File), 19 | Model. 20 | 21 | save_model(File, Model) -> 22 | ok = file:write_file(File, io_lib:format("~tp.~n", [Model])), 23 | Model. 24 | 25 | -else. 26 | 27 | load_model(File) -> 28 | {ok, Bin} = file:read_file(File), 29 | binary_to_term(Bin). 30 | 31 | save_model(File, Model) -> 32 | ok = file:write_file(File, term_to_binary(Model)), 33 | Model. 34 | 35 | -endif. 36 | 37 | get_elements_at_pos(Model, {L, C}) -> 38 | #model{defs=Defs, refs=Refs} = Model, 39 | MyPos = {L, C}, 40 | Defs1 = lists:filter(fun(#def{name_range=Y,info=X})-> 41 | case maps:is_key(body, X) of 42 | true -> 43 | pos_between(MyPos, maps:get(body, X)); 44 | _ -> 45 | false 46 | end 47 | end, Defs), 48 | Defs2 = lists:filter(fun(#def{name_range=X})-> pos_between(MyPos, X) end, Defs), 49 | Refs1 = lists:filter(fun(#ref{range=X})-> pos_between(MyPos, X) end, Refs), 50 | {Defs1, Refs1++Defs2}; 51 | get_elements_at_pos(Model, Pos) -> 52 | #{line:=L, character:=C} = Pos, 53 | get_elements_at_pos(Model, {L, C}). 54 | 55 | print_key(Key) -> 56 | unicode: characters_to_binary(print_key_aux(Key)). 57 | 58 | pos_between(_Crt, none) -> 59 | false; 60 | pos_between(Crt, {Start, End}) -> 61 | Start =< Crt andalso Crt < End. 62 | 63 | print_key_aux(Key) when is_list(Key) -> 64 | [print_key_aux(K) || K<-Key]; 65 | print_key_aux({module, M}) -> 66 | io_lib:format("~w:", [M]); 67 | print_key_aux({include, F}) -> 68 | io_lib:format("\"~s\"", [F]); 69 | print_key_aux({include_lib, F}) -> 70 | io_lib:format("\"~s\"", [F]); 71 | print_key_aux({function, F, A}) -> 72 | io_lib:format("~w/~w", [F, A]); 73 | print_key_aux({clause, N}) -> 74 | io_lib:format("@~w", [N]); 75 | print_key_aux({var, V}) -> 76 | io_lib:format("~w", [V]); 77 | print_key_aux({record, R}) -> 78 | io_lib:format("#~w", [R]); 79 | print_key_aux({field, F}) -> 80 | io_lib:format(".~w", [F]); 81 | print_key_aux({macro, M, -1}) -> 82 | io_lib:format("?~s", [M]); 83 | print_key_aux({macro, M, A}) -> 84 | io_lib:format("?~s/~w", [M, A]); 85 | print_key_aux({type, T, A}) -> 86 | io_lib:format("~w()/~w", [T, A]); 87 | print_key_aux(X) -> 88 | io_lib:format("~w", [X]). 89 | 90 | 91 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_operations.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_operations). 2 | 3 | -export([ 4 | hover/3, 5 | definition/3, 6 | references/4, 7 | completion/3, 8 | resolve_completion/2, 9 | highlight/3, 10 | symbols/2, 11 | document_symbols/2 12 | ]). 13 | 14 | %%-define(DEBUG, true). 15 | -include("debug.hrl"). 16 | 17 | -include("sourcer_model.hrl"). 18 | 19 | -spec hover(uri(), pos(), db()) -> text(). 20 | hover(Uri, Position, DB) -> 21 | Model = sourcer_db:get_model(Uri, DB), 22 | case sourcer_model:get_elements_at_pos(Model, Position) of 23 | {_, [#def{}=Def|_]} -> 24 | hover_for([{Uri,Def}], DB); 25 | {_, [#ref{ctx=Key}|_]} -> 26 | %% TODO not variables! 27 | hover_for(get_def(Key, DB), DB); 28 | _Other -> 29 | ?D({hover, "???", _Other}), 30 | [] 31 | end. 32 | 33 | -spec definition(uri(), pos(), db()) -> [{uri(), def()}]. 34 | definition(Uri, Position, DB) -> 35 | Model = sourcer_db:get_model(Uri, DB), 36 | case sourcer_model:get_elements_at_pos(Model, Position) of 37 | {_, [#def{}=Def|_]} -> 38 | [{Uri, Def}]; 39 | {_, [#ref{ctx=Key}|_]} -> 40 | %% TODO not variables! 41 | get_def(Key, DB); 42 | {[#def{}=Def], _} -> 43 | [{Uri, Def}]; 44 | _Other -> 45 | ?D({hover, "???", _Other}), 46 | [] 47 | end. 48 | 49 | -type refdef() :: ref() | def(). 50 | -spec references(uri(), pos(), map(), db()) -> [{uri(), refdef()}]. 51 | references(Uri, Position, Context, DB) -> 52 | Model = sourcer_db:get_model(Uri, DB), 53 | case sourcer_model:get_elements_at_pos(Model, Position) of 54 | {_,[Ref]} -> 55 | Val = get_refs(Ref#ref.ctx, DB), 56 | ?D(Context), 57 | case maps:get('includeDeclaration', Context, false) of 58 | true -> 59 | get_def(Ref#ref.ctx, DB) ++ Val; 60 | false -> 61 | Val 62 | end; 63 | _ -> 64 | [] 65 | end. 66 | 67 | completion(Uri, Position, DB) -> 68 | Model = sourcer_db:get_model(Uri, DB), 69 | {[], true}. 70 | 71 | resolve_completion(Params, DB) -> 72 | %Model = sourcer_db:get_model(Uri, DB), 73 | []. 74 | 75 | document_symbols(Uri, DB) -> 76 | Model = sourcer_db:get_model(Uri, DB), 77 | Model#model.defs. 78 | 79 | symbols(<<"">>, _DB) -> 80 | []; 81 | symbols(Query, DB) -> 82 | Models = dict:to_list(DB#db.models), 83 | Filter = fun({_, #def{ctx=Key}}) -> 84 | Name=sourcer_lsp:print_name(Key), 85 | string:find(Name, Query)=/=nomatch 86 | end, 87 | lists:filter(Filter, lists:flatten([symbol_list(Uri, M#model.defs) || {Uri, #db_entry{model=M}}<-Models])). 88 | 89 | highlight(Uri, Position, DB) -> 90 | Refs = references(Uri, Position, #{includeDeclaration=>false}, DB), 91 | LRefs = [X || {Uri, X}<-Refs], 92 | Def = definition(Uri, Position, DB), 93 | LDef = [X || {Uri, X}<-Def], 94 | LRefs++LDef. 95 | 96 | %%%%%%%%%%%%%%%%%%% 97 | 98 | hover_for([{Uri, #def{ctx=Key,info=Info}}|_], DB) -> 99 | Text = sourcer_db:get_text(Uri, DB), 100 | DocRange = maps:get(comments, Info, none), 101 | Doc = sourcer_util:get_text_range(Text, DocRange), 102 | SpecRange = maps:get(spec, Info, none), 103 | Spec = sourcer_util:get_text_range(Text, SpecRange), 104 | SpecDocRange = maps:get(spec_comments, Info, none), 105 | SpecDoc = sourcer_util:get_text_range(Text, SpecDocRange), 106 | hover_content(Key, SpecDoc, Spec, Doc); 107 | hover_for(_Tgt, _) -> 108 | ?D({hover, '---', _Tgt}), 109 | []. 110 | 111 | hover_content(Key, SpecDoc, Spec, Doc) -> 112 | Fmt = "### ~s 113 | 114 | ~s 115 | 116 | ~s 117 | 118 | ~s 119 | ", 120 | io_lib:format(Fmt, 121 | [sourcer_lsp:print_name(Key), SpecDoc, ["```\n", Spec, "\n```\n"], Doc]). 122 | 123 | get_def(Key, DB) -> 124 | Entries = dict:to_list(DB#db.models), 125 | Pred = fun({_,#db_entry{model=M}}) -> 126 | not lists:keymember(Key, #def.ctx, M#model.defs) 127 | end, 128 | case lists:dropwhile(Pred, Entries) of 129 | [{Uri,Item}|_] -> 130 | case lists:keyfind(Key, #def.ctx, Item#db_entry.model#model.defs) of 131 | false -> 132 | []; 133 | #def{}=Def -> 134 | %?D([Uri, Def]), 135 | [{Uri, Def}] 136 | end; 137 | _X -> 138 | [] 139 | end. 140 | 141 | get_refs(Key, DB) -> 142 | Entries = dict:to_list(DB#db.models), 143 | Pred = fun({_,#db_entry{model=M}}) -> 144 | lists:keymember(Key, #ref.ctx, M#model.refs) 145 | end, 146 | {Found, _} = lists:partition(Pred, Entries), 147 | lists:flatten([get_refs_aux(Uri, Key, Item) || {Uri, Item}<-Found]). 148 | 149 | get_refs_aux(Uri, Key, Item) -> 150 | case lists:keyfind(Key, #def.ctx, Item#db_entry.model#model.refs) of 151 | false -> 152 | []; 153 | #ref{}=Ref -> 154 | [{Uri, Ref}] 155 | end. 156 | 157 | symbol_list(Uri, Defs) -> 158 | [{Uri, X} || X<-Defs]. -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_parse_util.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_parse_util). 2 | 3 | -export([ 4 | get_line_text/2, 5 | get_line_text/3, 6 | 7 | extract_top_comments/1, 8 | 9 | take_until_token/2, 10 | take_until_token/3, 11 | split_at_token/2, 12 | split_at_token/3, 13 | take_until_matching_token/2, 14 | 15 | middle/1, 16 | 17 | take_block_list/1 18 | ]). 19 | 20 | %%-define(DEBUG, true). 21 | -include("debug.hrl"). 22 | 23 | -define(k(X), {X,_,_,_}). 24 | -define(LPAR, '('). 25 | -define(RPAR, ')'). 26 | 27 | get_line_text(String, {_, Ofs, Len, _}) -> 28 | string:substr(String, Ofs+1, Len). 29 | 30 | get_line_text(String, Index, LineInfo) -> 31 | I = lists:keyfind(Index, 1, LineInfo), 32 | get_line_text(String, I). 33 | 34 | extract_top_comments(Toks) -> 35 | Toks1 = remove_inline_whitespace(Toks), 36 | % keep comments and whitespace at beginning 37 | SplitFun = fun(?k(white_space)) -> true; 38 | (?k(comment)) -> true; 39 | (_) -> false 40 | end, 41 | {Toks2, Rest} = lists:splitwith(SplitFun, Toks1), 42 | % remove last lines of whitespace 43 | DropFun = fun(?k(white_space))->true; 44 | (_) -> false 45 | end, 46 | Toks3 = lists:reverse(lists:dropwhile(DropFun, lists:reverse(Toks2))), 47 | {skip_unrelated_comments(Toks3, []), Rest}. 48 | 49 | remove_inline_whitespace(L) -> 50 | Fun = fun({white_space,_,_,V}) -> V=="\n"; (_)-> true end, 51 | lists:filter(Fun, L). 52 | 53 | %% only the last block of comments before the form is kept 54 | skip_unrelated_comments([], Acc) -> 55 | compact_comments(lists:reverse(Acc)); 56 | skip_unrelated_comments([?k(comment)=_C,{white_space, _, _, "\n"},{white_space, _, _, "\n"}|Toks], _Acc) -> 57 | skip_unrelated_comments(Toks, []); 58 | skip_unrelated_comments([?k(comment)=C,{white_space, _, _, "\n"}|Toks], Acc) -> 59 | skip_unrelated_comments(Toks, [C|Acc]); 60 | skip_unrelated_comments([?k(comment)=C|Toks], Acc) -> 61 | skip_unrelated_comments(Toks, [C|Acc]); 62 | skip_unrelated_comments([?k(white_space)=_C|Toks], Acc) -> 63 | skip_unrelated_comments(Toks, Acc). 64 | 65 | compact_comments([]) -> 66 | none; 67 | compact_comments(L) -> 68 | {_,P1,_,_} = hd(L), 69 | {_,{L2,C2},T,_} = lists:last(L), 70 | {P1, {L2,C2+length(T)}}. 71 | 72 | %% split list at the first occurence of delimiter; 73 | %% if delimiter not found, return whole list as result. 74 | take_until_token(L, Delim) -> 75 | take_until_token(L, Delim, fun(_)-> true end). 76 | 77 | %% split list at the first occurence of delimiter and where 78 | %% Pred(Rest) == true; if Pred is never true, return whole list as result; 79 | %% if encountering blocks, handle them properly. 80 | take_until_token(L, Delim, Pred) -> 81 | take_until_token(L, Delim, Pred, []). 82 | 83 | take_until_token([], _Delim, _Pred, R) -> 84 | {lists:flatten(lists:reverse(R)), none, []}; 85 | take_until_token([?k(Delim)=H|Rest], Delim, Pred, R) -> 86 | case Pred(Rest) of 87 | true -> 88 | {lists:flatten(lists:reverse(R)), H, Rest}; 89 | false -> 90 | take_until_token(Rest, Delim, Pred, [H|R]) 91 | end; 92 | take_until_token([?k(K)=H|Rest], Delim, Pred, R) -> 93 | case lists:keyfind(K, 1, get_block_tokens()) of 94 | false -> 95 | take_until_token(Rest, Delim, Pred, [H|R]); 96 | _ -> 97 | Rest2 = case {K, Rest} of 98 | {'fun', [?k(?LPAR)=Hh|_]} -> 99 | % check if it is a defun or type 100 | {_, _, _, Bb} = take_until_matching_token(Hh, tl(Rest)), 101 | case Bb of 102 | [?k('->')|_] -> 103 | false; 104 | _ -> 105 | Bb 106 | end; 107 | {'fun', [?k(_),?k(':')|_]} -> 108 | Rest; 109 | {'fun', [?k(_),?k('/')|_]} -> 110 | Rest; 111 | _ -> 112 | false 113 | end, 114 | case Rest2 of 115 | false -> 116 | {HH, LL, TT, RR} = take_until_matching_token(H, Rest), 117 | case TT of 118 | none -> 119 | take_until_token(RR, Delim, Pred, [LL|[HH|R]]); 120 | _ -> 121 | take_until_token(RR, Delim, Pred, [TT|[LL|[HH|R]]]) 122 | end; 123 | _ -> 124 | take_until_token(Rest, Delim, Pred, [H|R]) 125 | end 126 | end. 127 | 128 | %% surrounding tokens are included in result 129 | take_until_matching_token(?k(T1)=H, Rest) -> 130 | case lists:keyfind(T1, 1, get_block_tokens()) of 131 | false -> 132 | %% should not happen 133 | {error, bad_token, T1}; 134 | {T1, T2} -> 135 | {A, D, B} = take_until_token(Rest, T2), 136 | case D of 137 | none -> 138 | {H, A, none, B}; 139 | _ -> 140 | {H, A, D, B} 141 | end 142 | end. 143 | 144 | %% the pairs of tokens that build structured code 145 | get_block_tokens() -> 146 | [ 147 | {'(', ')'}, 148 | {'[', ']'}, 149 | {'{', '}'}, 150 | {'<<', '>>'}, 151 | {'begin', 'end'}, 152 | {'if', 'end'}, 153 | {'case', 'end'}, 154 | {'receive', 'end'}, 155 | {'try', 'end'}, 156 | {'fun', 'end'} 157 | ]. 158 | 159 | %% split list at all delimiters; result does not include delimiters 160 | %% returns [{[token], delimiter token}] 161 | split_at_token(L, Delim) -> 162 | split_at_token(L, Delim, fun(_)-> true end). 163 | 164 | split_at_token([], _Delim, _Pred) -> 165 | []; 166 | split_at_token(L, Delim, Pred) -> 167 | {H, D, T} = take_until_token(L, Delim, Pred), 168 | DD = case D of 169 | none -> 170 | none; 171 | _ -> 172 | D 173 | end, 174 | [{H,DD}|split_at_token(T, Delim, Pred)]. 175 | 176 | middle([]) -> 177 | []; 178 | middle([_]) -> 179 | []; 180 | middle([_|T]) -> 181 | lists:reverse(tl(lists:reverse(T))). 182 | 183 | skip_percent("%"++L) -> 184 | skip_percent(L); 185 | skip_percent(L) -> 186 | L. 187 | 188 | take_block_list(L) -> 189 | {_, Args0, _, Rest} = take_until_matching_token(hd(L), tl(L)), 190 | A = split_at_token(Args0, ','), 191 | {[Ts||{Ts,_}<-A], Rest}. 192 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_project.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_project). 2 | 3 | -record(project, { 4 | root, 5 | sources=[], 6 | includes=[], 7 | projects=[] 8 | }). 9 | -------------------------------------------------------------------------------- /apps/sourcer/src/sourcer_util.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_util). 2 | 3 | -export([ 4 | pack/1, 5 | unpack/1, 6 | join/2, 7 | path_to_uri/1, 8 | uri_to_path/1 9 | ]). 10 | -export([ 11 | reverse2/1 12 | ]). 13 | -export([ 14 | get_text_range/2 15 | ]). 16 | -export([ 17 | get_auto_imported/1, 18 | add_auto_imported/1 19 | ]). 20 | 21 | %%-define(DEBUG, true). 22 | -include("debug.hrl"). 23 | 24 | -define(SEP, ";"). 25 | 26 | unpack(F) -> 27 | string:tokens(F, ?SEP). 28 | 29 | pack(L) -> 30 | join(L, ?SEP). 31 | 32 | reverse2(L) when is_list(L) -> 33 | lists:reverse([lists:reverse(A) || A <- L]). 34 | 35 | join([], Sep) when is_list(Sep) -> 36 | []; 37 | join([H|T], Sep) -> 38 | H ++ lists:append([Sep ++ X || X <- T]). 39 | 40 | add_auto_imported(Imports) -> 41 | [{erlang, get_auto_imported("")} | Imports]. 42 | 43 | get_auto_imported(Prefix) when is_list(Prefix) -> 44 | case catch erlang:module_info(exports) of 45 | Val when is_list(Val) -> 46 | lists:filter(fun({N, A}) -> 47 | lists:prefix(Prefix, atom_to_list(N)) andalso 48 | erl_internal:bif(N, A) 49 | end, Val); 50 | _Error -> 51 | ?D(_Error), 52 | error 53 | end. 54 | 55 | get_text_range(Text, none) -> 56 | <<"">>; 57 | get_text_range(Text, Range) -> 58 | {{L1, C1},{L2,C2}} = Range, 59 | {ok, RE} = re:compile("\\R", [multiline, {newline, anycrlf}, unicode]), 60 | case re:run(Text, RE, [global]) of 61 | {match, Lines} -> 62 | [{X1, X2}] = lists:nth(L1, Lines), 63 | [{Y1, Y2}] = lists:nth(L2, Lines), 64 | From = X1 + X2 + C1 - 1, 65 | Length = Y1 + Y2 + C2 - From, 66 | string:slice(Text, From, Length); 67 | nomatch -> 68 | ?D("NO LINES????"), 69 | <<"">> 70 | end. 71 | 72 | %% Transforms URI into file path 73 | uri_to_path(URI) -> 74 | {ok, {file,_,_,_,Path,_}=Fragments} = http_uri:parse(unicode:characters_to_list(URI), 75 | [{scheme_defaults,[{file,1}]}] 76 | ), 77 | Path1 = http_uri:decode(Path), 78 | case lists:member($:, Path1) of 79 | true -> 80 | Path2 = case Path1 of 81 | "/"++Path2 -> Path2; 82 | Path2 -> Path2 83 | end, 84 | lists:flatten(string:replace(Path2, "/", "\\", all)); 85 | false -> 86 | Path1 87 | end. 88 | 89 | %% Transforms an absolute file path into a URI as used by the language server protocol. 90 | path_to_uri(Path) -> 91 | Path1 = string:strip(lists:flatten(string:replace(Path, "\\", "/", all)), both, $/), 92 | [H|T] = Parts = string:split(Path1, "/", all), 93 | First = case lists:member($:, H) of 94 | false -> 95 | H; 96 | true -> 97 | http_uri:encode(H) 98 | end, 99 | Path2 = string:join([First | [http_uri:encode(X) || X<-T]], "/"), 100 | unicode:characters_to_binary("file:///"++Path2). 101 | 102 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_comment.erl: -------------------------------------------------------------------------------- 1 | %% Author: jakob 2 | %% Created: Mar 23, 2006 3 | 4 | -module(sourcer_comment). 5 | 6 | -export([toggle_comment/3]). 7 | 8 | %-define(DEBUG, 1). % 9 | 10 | -include("debug.hrl"). 11 | 12 | %% 13 | %% API Functions 14 | %% 15 | 16 | toggle_comment(Text, From, Length) -> 17 | ?D({Text, From, Length}), 18 | {_, _, Lines} = sourcer_text:get_text_and_lines(Text, From, Length), 19 | ?D(Lines), 20 | LineF = case lists:all(fun(L) -> is_comment_line(L) end, Lines) of 21 | true -> 22 | fun(L) -> uncomment_line(L) end; 23 | false -> 24 | fun(L) -> comment_line(L) end 25 | end, 26 | lists:flatten(lists:map(LineF, Lines)). 27 | 28 | %% 29 | %% Local Functions 30 | %% 31 | 32 | is_comment_line("") -> false; 33 | is_comment_line(" " ++ Rest) -> is_comment_line(Rest); 34 | is_comment_line("\t" ++ Rest) -> is_comment_line(Rest); 35 | is_comment_line("%" ++ _) -> true; 36 | is_comment_line(_) -> false. 37 | 38 | uncomment_line(Line) -> uncomment_line_x(Line). 39 | 40 | uncomment_line_x("%% " ++ Rest) -> Rest; 41 | uncomment_line_x("%%" ++ Rest) -> Rest; 42 | uncomment_line_x("%" ++ Rest) -> Rest; 43 | uncomment_line_x(" " ++ Rest) -> uncomment_line_x(Rest); 44 | uncomment_line_x(Line) -> Line. 45 | 46 | comment_line("") -> ""; 47 | comment_line(Line) -> ["%% ", Line]. 48 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_doc_server.erl: -------------------------------------------------------------------------------- 1 | %%% 2 | 3 | -module(sourcer_doc_server). 4 | 5 | -export([ 6 | get_raw_documentation/3, 7 | get_documentation/3 8 | ]). 9 | 10 | -type root() :: 11 | {'lib', string()} | 12 | {'app', string()}. 13 | -type configuration() :: 14 | #{ 15 | 'roots' => [root()] 16 | }. 17 | 18 | -type doc_ref() :: 19 | {'application', atom()} | 20 | {'module', atom()} | 21 | {'function', {atom(), atom(), integer()}} | 22 | {'macro', {atom(), atom(), integer()}} | 23 | {'record', {atom(), atom(), integer()}} | 24 | {'behaviour', atom()} | 25 | {'type', {atom(), atom(), integer()}}. 26 | 27 | -type doc_tree() :: any(). 28 | 29 | -type doc_result() :: {'ok', [{atom(), doc_tree()}]} | {'error', any()}. 30 | -type raw_doc_result() :: {'ok', [{atom(), iolist()}]} | {'error', any()}. 31 | 32 | -type provider() :: fun((doc_ref()) -> {'ok', {atom(), iolist()}} | {'error', any()}). 33 | 34 | -spec get_documentation(configuration(), doc_ref(), [provider()]) -> doc_result(). 35 | get_documentation(Config, Ref, Providers) -> 36 | RawDocs = get_raw_documentation(Config, Ref, Providers), 37 | convert(Config, Providers, RawDocs). 38 | 39 | -spec get_raw_documentation(configuration(), doc_ref(), [provider()]) -> raw_doc_result(). 40 | get_raw_documentation(Config, Ref, Providers) -> 41 | traverse(Config, Providers, Ref). 42 | 43 | %% ==================================================================== 44 | %% Internal functions 45 | %% ==================================================================== 46 | 47 | traverse(Config, L, Args) -> 48 | traverse(Config, L, Args, [], []). 49 | 50 | traverse(_Config, [], _Args, Result, []) -> 51 | {ok, lists:reverse(Result)}; 52 | traverse(_Config, [], _Args, Result, Errs) -> 53 | {error, {lists:reverse(Errs), lists:reverse(Result)}}; 54 | traverse(Config, [M|T], Args, Result, Err) -> 55 | case catch apply(M, Args) of 56 | {error, E} -> 57 | traverse(Config, T, Args, Result, [E|Err]); 58 | {'EXIT', E} -> 59 | traverse(Config, T, Args, Result, [E|Err]); 60 | {ok, V} -> 61 | traverse(Config, T, Args, [V|Result], Err); 62 | V -> 63 | traverse(Config, T, Args, [V|Result], Err) 64 | end. 65 | 66 | convert(Config, Providers, {ok, Docs}) -> 67 | {ok, convert1(Config, Providers, Docs, [])}; 68 | convert(Config, Providers, {error, Errors, Docs}) -> 69 | {error, Errors, convert1(Config, Providers, Docs, [])}. 70 | 71 | convert1(_Config, _Providers, [], Result) -> 72 | lists:reverse(Result); 73 | convert1(Config, Providers, [{M, D}|T], Result) -> 74 | case lists:keyfind(M, 1, Providers) of 75 | {M, P} -> 76 | V = P:convert(D), 77 | convert1(Config, Providers, T, [V|Result]); 78 | false -> 79 | convert1(Config, Providers, T, Result) 80 | end. 81 | 82 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 83 | 84 | -include_lib("eunit/include/eunit.hrl"). 85 | 86 | traverse_test_() -> 87 | [ 88 | ?_assertEqual({ok, [[1,2]]},traverse(#{}, [fun lists:seq/2], [1,2])), 89 | ?_assertEqual({ok, []},traverse(#{}, [], [])) 90 | ]. 91 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_doc_util.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_doc_util). 2 | 3 | -export([ 4 | get_between_strs/3, 5 | get_all_between_strs/3, 6 | get_from_str/2, 7 | get_upto_str/2 8 | ]). 9 | 10 | -include("debug.hrl"). 11 | 12 | get_from_str(Text, Start) -> 13 | case string:str(Text, Start) of 14 | 0 -> 15 | Text; 16 | N -> 17 | string:substr(Text, N + length(Start)) 18 | end. 19 | 20 | get_between_strs(Text, Start, End) -> 21 | get_upto_str(get_from_str(Text, Start), End). 22 | 23 | get_all_between_strs(Text, Start, End) -> 24 | {One, Next} = split_at(get_from_str(Text, Start), End), 25 | case Next of 26 | "" -> 27 | [One]; 28 | _ -> 29 | [One | get_all_between_strs(Next, Start, End)] 30 | end. 31 | 32 | get_upto_str(Text, End) -> 33 | case string:rstr(Text, End) of 34 | 0 -> 35 | Text; 36 | N -> 37 | string:substr(Text, 1, N-1) 38 | end. 39 | 40 | split_at(Text, End) -> 41 | case string:str(Text, End) of 42 | 0 -> 43 | {Text, ""}; 44 | N -> 45 | {string:substr(Text, 1, N-1), string:substr(Text, N+length(End))} 46 | end. 47 | 48 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_edoc.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_edoc). 2 | 3 | -export([files/2]). 4 | 5 | files(Files, Options) -> 6 | try 7 | %sourcer_log:logp(Files), 8 | %sourcer_log:logp(Options), 9 | [begin 10 | %sourcer_log:logp(F), 11 | edoc:files([F], Options) end || F<-Files] 12 | catch 13 | _:Err -> 14 | {error, Err} 15 | end. 16 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_edoc_doc_provider.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_edoc_doc_provider). 2 | 3 | -export([ 4 | get_documentation/1 5 | ]). 6 | 7 | get_documentation({Kind, Ref}) -> 8 | R = lists:flatten(io_lib:format("EDOC:: ~p ~p", [Kind, Ref])), 9 | {ok, {edoc, R}}; 10 | get_documentation(Arg) -> 11 | {error, {badarg, Arg}}. 12 | 13 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_model.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_model). 2 | 3 | -export([ 4 | init/2, 5 | change_configuration/2, 6 | open_document/5, 7 | change_document/4, 8 | save_document/2, 9 | close_document/2, 10 | change_watched_files/2 11 | ]). 12 | 13 | -type path_item() :: {'lib'|'app'|'file', string()}. 14 | 15 | -type state() :: #{ 16 | 'workspace' => string(), 17 | 'open_documents' => [any()], 18 | 'code_path' => [path_item()], 19 | 'logger' => atom(), 20 | 'files' => [{string(), boolean()}], 21 | 'parser' => fun((string()) -> any()) 22 | }. 23 | 24 | %-define(LOG(X), State#state.logger:log(X)). 25 | -define(LOG(X), io:format("~p~n", [X])). 26 | 27 | -spec init(string(), atom()) -> {'ok', state()} | {'error', any()}. 28 | init(Workspace, Logger) -> 29 | State = #{ 30 | files => [], 31 | parser => fun parse_file/1 32 | }, 33 | change_configuration(State, [ 34 | {workspace, Workspace}, 35 | {logger, Logger} 36 | ]). 37 | 38 | -spec change_configuration(state(), [{atom(), any()}]) -> 39 | {'ok', state()} | {'error', any()}. 40 | change_configuration(State, Settings) -> 41 | NewState = maps:merge(State, maps:from_list(Settings)), 42 | ?LOG({change_configuration, State, NewState}), 43 | {ok, NewState}. 44 | 45 | -spec open_document(state(), string(), atom(), integer(), iolist()) -> 46 | {'ok', state()} | {'error', any()}. 47 | open_document(State, _Uri, _LangId, _Version, _Text) -> 48 | NewState = State, 49 | ?LOG({open_document, State, NewState}), 50 | {ok, NewState}. 51 | 52 | -spec change_document(state(), sourcer_lsp_server:text_document_id(), integer(), [sourcer_lsp_server:content_change()]) -> 53 | {'ok', state()} | {'error', any()}. 54 | change_document(State, _DocumentId, _Version, _Changes) -> 55 | NewState = State, 56 | ?LOG({change_document, State, NewState}), 57 | {ok, State}. 58 | 59 | -spec close_document(state(), sourcer_lsp_server:text_document_id()) -> 60 | {'ok', state()} | {'error', any()}. 61 | close_document(State, _DocumentId) -> 62 | NewState = State, 63 | ?LOG({close_document, State, NewState}), 64 | {ok, State}. 65 | 66 | -spec save_document(state(), sourcer_lsp_server:text_document_id()) -> 67 | {'ok', state()} | {'error', any()}. 68 | save_document(State, _DocumentId) -> 69 | NewState = State, 70 | ?LOG({save_document, State, NewState}), 71 | {ok, State}. 72 | 73 | -spec change_watched_files(state(), [sourcer_lsp_server:file_event()]) -> 74 | {'ok', state()} | {'error', any()}. 75 | change_watched_files(State=#{files:=Files, parser:=Parser}, FileEvents) -> 76 | NewFiles = lists:foldl(fun update_file_change/2, Files, FileEvents), 77 | NewFiles1 = lists:map(parse(Parser), NewFiles), 78 | NewState = State#{files=>NewFiles1}, 79 | ?LOG({change_watched_files, State, NewState}), 80 | {ok, NewState}. 81 | 82 | %%%%%%%%%%%%%%%%%%% 83 | 84 | update_file_change({File, created}, Files) -> 85 | update_file_change({File, changed}, Files); 86 | update_file_change({File, changed}, Files) -> 87 | NewFiles0 = lists:keydelete(File, 1, Files), 88 | NewFiles = [{File, true} | NewFiles0], 89 | NewFiles; 90 | update_file_change({File, deleted}, Files) -> 91 | NewFiles = lists:keydelete(File, 1, Files), 92 | NewFiles. 93 | 94 | parse(Parser) -> 95 | fun({File, false}) -> 96 | {File, false}; 97 | ({File, true}) -> 98 | spawn(fun()->Parser(File) end), 99 | {File, false} 100 | end. 101 | 102 | parse_file(_File) -> 103 | ok. 104 | 105 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_module.erl: -------------------------------------------------------------------------------- 1 | %%% ****************************************************************************** 2 | %%% Copyright (c) 2009 Vlad Dumitrescu and others. 3 | %%% All rights reserved. This program and the accompanying materials 4 | %%% are made available under the terms of the Eclipse Public License v1.0 5 | %%% which accompanies this distribution, and is available at 6 | %%% http://www.eclipse.org/legal/epl-v10.html 7 | %%% 8 | %%% Contributors: 9 | %%% Vlad Dumitrescu 10 | %%% ******************************************************************************/ 11 | -module(sourcer_module). 12 | 13 | -export([ 14 | start/1, 15 | contentChange/4 16 | ]). 17 | 18 | -include("debug.hrl"). 19 | 20 | %% For now we have a simple content model: a string. 21 | 22 | -record(state, {name, content=""}). 23 | 24 | start(Name) -> 25 | spawn(fun() -> 26 | erlang:process_flag(save_calls, 50), 27 | loop(#state{name=Name}) 28 | end). 29 | 30 | contentChange(Pid, Offset, Length, Text) -> 31 | Pid ! {change, Offset, Length, Text}. 32 | 33 | 34 | loop(State) -> 35 | receive 36 | stop -> 37 | ok; 38 | {get_string_content, From} -> 39 | From ! {module_content, State#state.content}, 40 | loop(State); 41 | {get_binary_content, From} -> 42 | From ! {module_content, list_to_binary(State#state.content)}, 43 | loop(State); 44 | {change, Offset, Length, Text}=_Msg -> 45 | % sourcer_log:logp("Module ~s:: ~p", [Name, _Msg]), 46 | Content1 = replace_text(State#state.content, Offset, Length, Text), 47 | loop(State#state{content=Content1}); 48 | _Msg -> 49 | %sourcer_log:logp("Unknown message in module ~s: ~p", [State#state.name, _Msg]), 50 | loop(State) 51 | end. 52 | 53 | replace_text(Initial, Offset, Length, Text) -> 54 | {A, B} = lists:split(Offset, Initial), 55 | {_, C} = lists:split(Length, B), 56 | A++Text++C. 57 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_np_records.erl: -------------------------------------------------------------------------------- 1 | %% Author: jakob 2 | %% Created: 18 dec 2010 3 | -module(sourcer_np_records). 4 | 5 | -include("sourcer_token.hrl"). 6 | -include("sourcer_search.hrl"). 7 | 8 | -export([check_fields/2]). 9 | 10 | %% 11 | %% API Functions 12 | %% 13 | 14 | 15 | % check refs to record fields 16 | % 17 | 18 | check_fields(Tokens, RecordName) -> 19 | check_fields(record_name, Tokens, RecordName, [], '', []). 20 | 21 | %% 22 | %% Local Functions 23 | %% 24 | 25 | check_fields(_State, [], _RecordName, Fields, _PrevRecordName, RightSides) -> 26 | {[], Fields, lists:reverse(RightSides)}; 27 | check_fields(_State, [#token{kind='}'} | Rest], _RecordName, Fields, _PrevRecordName, RightSides) -> 28 | {Rest, Fields, lists:reverse(RightSides)}; 29 | %% check_fields(_State, [#token{kind=','} | Rest], _RecordName, Fields, '', RightSides) -> 30 | %% {Rest, Fields, lists:reverse(RightSides)}; 31 | check_fields(_State, [#token{kind='#'} | Rest], RecordName, Fields, PrevRecordName, RightSides) -> % 1 32 | check_fields(record_want_name, Rest, RecordName, Fields, PrevRecordName, RightSides); 33 | check_fields(record_want_name, [#token{kind=atom, value=NewRecordName} | Rest], RecordName, Fields, _PrevRecordName, RightSides) -> % 2 34 | check_fields(record_name, Rest, NewRecordName, Fields, RecordName, RightSides); 35 | check_fields(record_want_name, [#token{kind=macro, value=NewRecordName} | Rest], RecordName, Fields, _PrevRecordName, RightSides) -> % 2 36 | check_fields(record_name, Rest, NewRecordName, Fields, RecordName, RightSides); 37 | check_fields(record_want_name, [#token{kind='?'} | Rest], RecordName, Fields, _PrevRecordName, RightSides) -> % 2 38 | check_fields(record_name, Rest, '?', Fields, RecordName, RightSides); 39 | check_fields(record_name, [#token{kind=Dot} | Rest], RecordName, Fields, PrevRecordName, RightSides) % 3 40 | when Dot=:='.'; Dot=:=dot-> 41 | check_fields(record_want_dot_field, Rest, RecordName, Fields, PrevRecordName, RightSides); 42 | check_fields(record_want_dot_field, [#token{kind=atom, value=FieldName, offset=Offset, length=Length} | Rest], 43 | RecordName, Fields, _PrevRecordName, RightSides) -> % 4 44 | NewFields = [{Offset, Length, #record_field_ref{name=FieldName, record=RecordName}} | Fields], 45 | {Rest, NewFields, lists:reverse(RightSides)}; 46 | check_fields(record_name, [#token{kind='{'} | Rest], RecordName, Fields, PrevRecordName, RightSides) -> % 5 47 | check_fields(record_want_field, Rest, RecordName, Fields, PrevRecordName, RightSides); 48 | check_fields(State, [#token{kind='{'} | Rest], RecordName, Fields, PrevRecordName, RightSides) -> % 6 49 | {NewRest, NewFields, NewRS} = check_fields(no_record, Rest, RecordName, Fields, PrevRecordName, RightSides), 50 | check_fields(State, NewRest, RecordName, NewFields, PrevRecordName, lists:reverse(NewRS)); 51 | check_fields(record_want_field, [#token{kind=atom, value=FieldName, offset=Offset, length=Length} | Rest], 52 | RecordName, Fields, PrevRecordName, RightSides) -> % 7 53 | NewFields = [{Offset, Length, #record_field_ref{name=FieldName, record=RecordName}} | Fields], 54 | check_fields(record_field, Rest, RecordName, NewFields, PrevRecordName, RightSides); 55 | check_fields(no_record, [#token{kind=','} | Rest], RecordName, Fields, PrevRecordName, RightSides) -> % 8 56 | check_fields(record_want_field, Rest, RecordName, Fields, PrevRecordName, RightSides); 57 | check_fields(record_field, [#token{kind='='} | Rest], RecordName, Fields, PrevRecordName, RightSides) -> % 9 58 | check_fields(no_record, Rest, RecordName, Fields, PrevRecordName, RightSides); 59 | check_fields(_State, [T | Rest], RecordName, Fields, PrevRecordName, RightSides) -> % 10 60 | check_fields(no_record, Rest, RecordName, Fields, PrevRecordName, [T | RightSides]). 61 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_np_util.erl: -------------------------------------------------------------------------------- 1 | %% Author: jakob 2 | %% Created: 7 nov 2010 3 | -module(sourcer_np_util). 4 | 5 | %% -define(DEBUG, 1). 6 | 7 | -include("debug.hrl"). 8 | -include("sourcer_noparse.hrl"). 9 | -include("sourcer_token.hrl"). 10 | 11 | -export([extract_comments/1, skip_to/2, 12 | get_between_outer_pars/3, compact_model/1, get_top_level_comments/2]). 13 | 14 | %% @doc extract comments from tokens, and concatenate multiline comments to one token 15 | -spec extract_comments([token()]) -> {[token()],[token()]}. 16 | %% 17 | extract_comments(Tokens) -> 18 | extract_comments(Tokens, -1, [], []). 19 | 20 | extract_comments([], _, TAcc, CAcc) -> 21 | {lists:reverse(TAcc), lists:reverse(CAcc)}; 22 | extract_comments([#token{kind=comment, offset=ONext, length=LNext, line=NNext, 23 | text=VNext} 24 | | Rest], NNext, TAcc, 25 | [#token{kind=comment, offset=O, text=V}=C | CAcc]) -> 26 | NewComment = C#token{offset=O, length=ONext-O+LNext, text = <>, 27 | last_line=NNext-1}, 28 | extract_comments(Rest, NNext+1, TAcc, [NewComment | CAcc]); 29 | extract_comments([C = #token{kind=comment, line=N} | Rest], _, TAcc, CAcc) -> 30 | extract_comments(Rest, N+1, TAcc, [C | CAcc]); 31 | extract_comments([T | Rest], _, TAcc, CAcc) -> 32 | extract_comments(Rest, -1, [T | TAcc], CAcc). 33 | 34 | %% @doc drop tokens until delimiter 35 | -spec skip_to([token()], atom()) -> [token()]. 36 | %% 37 | skip_to([], _Delim) -> 38 | []; 39 | skip_to([#token{kind=Delim} | _] = L, Delim) -> 40 | L; 41 | skip_to([_ | Rest], Delim) -> 42 | skip_to(Rest, Delim). 43 | 44 | %% 45 | -spec get_between_outer_pars([token()], atom(), atom()) -> [token()]. 46 | %% 47 | get_between_outer_pars(T, L, R) -> 48 | case skip_to(T, L) of 49 | [] -> 50 | []; 51 | [_ | S] -> 52 | {RL, _Rest} = gbop(S, L, R), 53 | lists:reverse(tl(lists:reverse(RL))) 54 | end. 55 | 56 | gbop([], _L, _R) -> 57 | {[], []}; 58 | gbop([eof | _], _L, _R) -> 59 | {[], []}; 60 | gbop([#token{kind=R}=T | Rest], _L, R) -> 61 | {[T], Rest}; 62 | gbop([#token{kind=L}=T | Rest], L, R) -> 63 | {R1, Rest1} = gbop(Rest, L, R), 64 | {R2, Rest2} = gbop(Rest1, L, R), 65 | {[T] ++ R1 ++ R2, Rest2}; 66 | gbop([T | Rest], L, R) -> 67 | {LR, Rest1} = gbop(Rest, L, R), 68 | {[T] ++ LR, Rest1}. 69 | 70 | %% change model to more compact to miminize terms from erlang to java 71 | -spec compact_model(model()) -> model(). 72 | %% 73 | compact_model(#model{forms=Forms, comments=Comments}) -> 74 | FixedComments = compact_tokens(Comments), 75 | FixedForms = compact_forms(Forms), 76 | #model{forms=FixedForms, comments=FixedComments}. 77 | 78 | compact_forms(Forms) -> 79 | [compact_form(Form) || Form <- Forms]. 80 | 81 | compact_tokens(Tokens) -> 82 | [compact_token(Token) || Token <- Tokens]. 83 | 84 | compact_token(#token{value=Value} = Token) when is_list(Value) -> 85 | Token#token{value=unicode:characters_to_binary(Value)}; 86 | compact_token(#token{text=Text} = Token) when is_list(Text) -> 87 | Token#token{value=unicode:characters_to_binary(Text)}; 88 | compact_token(Token) -> 89 | Token. 90 | 91 | list_of_binaries(Args) when is_list(Args) -> 92 | [unicode:characters_to_binary(A) || A <- Args]; 93 | list_of_binaries(_) -> 94 | []. 95 | 96 | compact_form(#function{clauses=Clauses, args=Args} = Function) -> 97 | Function#function{clauses=compact_forms(Clauses), args=list_of_binaries(Args)}; 98 | compact_form(#clause{head=Head, args=Args} = Clause) -> 99 | Clause#clause{head=to_binary_with_unicode(Head), args=list_of_binaries(Args)}; 100 | compact_form(Other) -> 101 | Other. 102 | 103 | to_binary_with_unicode(Comment) when is_list(Comment) -> 104 | unicode:characters_to_binary(Comment); 105 | to_binary_with_unicode(Other) -> 106 | Other. 107 | 108 | %% @doc retrieve top level comments 109 | -spec get_top_level_comments([tuple()], [token()]) -> [token()]. 110 | %% 111 | get_top_level_comments(Forms, Comments) -> 112 | get_top_level_comments(Forms, Comments, []). 113 | 114 | get_top_level_comments(_Forms, [], Acc) -> 115 | lists:reverse(Acc); 116 | get_top_level_comments([], Comments, Acc) -> 117 | lists:reverse(Acc, Comments); 118 | get_top_level_comments([Form | FormRest] = Forms, 119 | [#token{offset=CommentOffset, length=CommentLength}=Comment | CommentRest] = Comments, 120 | Acc) -> 121 | {{_Line, _LastLine, FormOffset}, FormLength} = get_form_pos(Form), 122 | case relative_pos(CommentOffset, CommentLength, FormOffset, FormLength) of 123 | within -> 124 | get_top_level_comments(FormRest, CommentRest, Acc); 125 | before -> 126 | get_top_level_comments(Forms, CommentRest, [Comment | Acc]); 127 | 'after' -> 128 | get_top_level_comments(FormRest, Comments, Acc); 129 | overlapping -> 130 | get_top_level_comments(FormRest, CommentRest, Acc) 131 | end. 132 | 133 | get_form_pos(#function{pos=Pos}) -> Pos; 134 | get_form_pos(#attribute{pos=Pos}) -> Pos; 135 | get_form_pos(#clause{pos=Pos}) -> Pos; 136 | get_form_pos(#other{pos=Pos}) -> Pos. 137 | 138 | relative_pos(Offset1, Length1, Offset2, Length2) 139 | when Offset1 >= Offset2, Offset1 + Length1 =< Offset2 + Length2 -> 140 | within; 141 | relative_pos(Offset1, Length1, Offset2, _Length2) 142 | when Offset1+Length1 =< Offset2 -> 143 | before; 144 | relative_pos(Offset1, _Length1, Offset2, Length2) 145 | when Offset1 >= Offset2+Length2 -> 146 | 'after'; 147 | relative_pos(_, _, _, _) -> 148 | overlapping. 149 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_otp_xml_doc_provider.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_otp_xml_doc_provider). 2 | 3 | -export([ 4 | get_documentation/1 5 | ]). 6 | 7 | get_documentation({Kind, Ref}) -> 8 | R = lists:flatten(io_lib:format("OTP XML:: ~p ~p", [Kind, Ref])), 9 | {ok, {otp_xml, R}}; 10 | get_documentation(Arg) -> 11 | {error, {badarg, Arg}}. 12 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_parse.erl: -------------------------------------------------------------------------------- 1 | %% Description: Split source files into functions and clauses and collects references 2 | %% Author: jakob 3 | %% Created: Mar 23, 2006 4 | 5 | -module(sourcer_parse). 6 | 7 | %% called from Java 8 | -export([initial_parse/5, reparse/2]). 9 | 10 | %% called from Erlang 11 | -export([get_module_refs/4]). 12 | 13 | %-define(DEBUG, 1). 14 | 15 | 16 | -define(SERVER, sourcer_noparse). 17 | 18 | -include("debug.hrl"). 19 | -include("sourcer_parse.hrl"). 20 | -include("sourcer_scanner_server.hrl"). 21 | -include("sourcer_search.hrl"). 22 | 23 | %% 24 | %% API Functions 25 | %% 26 | 27 | -spec initial_parse(atom(), string(), string(), string(), boolean()) -> 28 | {ok, #model{}, [#ref{}]}. 29 | 30 | initial_parse(ScannerName, ModuleFileName, InitialText, StateDir, 31 | UpdateSearchServer) -> 32 | ?D({ScannerName, ModuleFileName, UpdateSearchServer}), 33 | RenewFun = fun(_F) -> 34 | Tokens = get_tokens(ScannerName, ModuleFileName, 35 | InitialText, StateDir), 36 | {Model, Refs} = 37 | do_parse(ScannerName, Tokens, UpdateSearchServer), 38 | {Model, Refs} 39 | end, 40 | {Model, Refs} = RenewFun(ModuleFileName), 41 | {ok, Model, Refs}. 42 | 43 | -spec reparse(atom(), boolean()) -> 44 | {ok, #model{}}. 45 | reparse(ScannerName, UpdateSearchServer) -> 46 | Tokens = sourcer_scanner:get_tokens(ScannerName), 47 | {Model, _Refs} = do_parse(ScannerName, Tokens, UpdateSearchServer), 48 | {ok, Model}. 49 | 50 | -spec get_module_refs(atom(), string(), string(), boolean()) -> [#ref{}]. 51 | get_module_refs(ScannerName, ModulePath, StateDir, UpdateSearchServer) -> 52 | BaseName = filename:join(StateDir, atom_to_list(ScannerName)), 53 | RefsFileName = BaseName ++ ".refs", 54 | %% TODO: shouldn't we check that .refs is up-to-date? using renew 55 | %% function etc. would probably be more straight-forward... 56 | ?D(RefsFileName), 57 | case file:read_file(RefsFileName) of 58 | {ok, Binary} -> 59 | binary_to_term(Binary); 60 | _ -> 61 | InitialText = case file:read_file(ModulePath) of 62 | {ok, InitialTextBin} -> 63 | unicode:characters_to_list(InitialTextBin); 64 | _ -> 65 | "" 66 | end, 67 | {ok, _, _, Refs} = initial_parse(ScannerName, ModulePath, InitialText, 68 | StateDir, UpdateSearchServer), 69 | Refs 70 | end. 71 | 72 | %% 73 | %% Internal functions 74 | %% 75 | 76 | get_tokens(ScannerName, ModuleFileName, InitialText, StateDir) -> 77 | case whereis(ScannerName) of 78 | undefined -> 79 | Module = sourcer_scanner:initial_scan_0(ScannerName, ModuleFileName, InitialText, StateDir), 80 | sourcer_scan_model:get_all_tokens(Module); 81 | _ -> 82 | sourcer_scanner:get_tokens(ScannerName) 83 | end. 84 | 85 | do_parse(ScannerName, Tokens, UpdateSearchServer) -> 86 | {Forms, Comments, References} = sourcer_np:parse(Tokens), 87 | ?D(Forms), 88 | Model = #model{forms=Forms, comments=Comments}, 89 | CompactModel = sourcer_np_util:compact_model(Model), 90 | ?D(CompactModel), 91 | update_search_server(UpdateSearchServer, ScannerName, References), 92 | {CompactModel, References}. 93 | 94 | update_search_server(true, ScannerName, Refs) -> 95 | sourcer_search_server:add_module_refs(ScannerName, Refs); 96 | update_search_server(_, _, _) -> 97 | ok. 98 | 99 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_parse_exprs.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_parse_exprs). 2 | 3 | %% API 4 | -export([consult/1]). 5 | 6 | consult(B) when is_binary(B) -> 7 | consult(unicode:characters_to_list(B)); 8 | consult(L) when is_list(L) -> 9 | {ok, Toks, _} = erl_scan:string(L), 10 | {FormToks, _} = ?util:split_at_dot(Toks), 11 | lists:map(fun parse1/1, FormToks). 12 | 13 | parse1(Toks) -> 14 | R = erl_parse:parse_exprs(Toks), 15 | case R of 16 | {ok, [Fs]} -> 17 | erl_parse:normalise(Fs); 18 | Err -> 19 | throw(Err) 20 | end. 21 | 22 | -ifdef(TEST). 23 | -include_lib("eunit/include/eunit.hrl"). 24 | 25 | consult_test_() -> 26 | [ 27 | ?_assertMatch([], consult("2")) 28 | ]. 29 | 30 | -endif. -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_scan_util.erl: -------------------------------------------------------------------------------- 1 | %% @author jakob 2 | %% @doc @todo Add description to sourcer_scan_util. 3 | 4 | -module(sourcer_scan_util). 5 | 6 | -export([ 7 | split_lines_w_lengths/1, 8 | find_line_w_offset/2, 9 | get_lines_info/1 10 | ]). 11 | 12 | %% [{Length, TextIncNL}...] 13 | split_lines_w_lengths(Text) -> 14 | split_lines_w_lengths(Text, 0, [], []). 15 | 16 | split_lines_w_lengths("", _Length, [], Acc) -> 17 | lists:reverse(Acc); 18 | split_lines_w_lengths("", Length, LineAcc, Acc) -> 19 | lists:reverse(Acc, [{Length, lists:reverse(LineAcc)}]); 20 | split_lines_w_lengths("\r\n" ++ Text, Length, LineAcc, Acc) -> 21 | split_lines_w_lengths(Text, 0, [], 22 | [{Length+2, lists:reverse(LineAcc, "\r\n")} | Acc]); 23 | split_lines_w_lengths("\n" ++ Text, Length, LineAcc, Acc) -> 24 | split_lines_w_lengths(Text, 0, [], 25 | [{Length+1, lists:reverse(LineAcc, "\n")} | Acc]); 26 | split_lines_w_lengths("\r" ++ Text, Length, LineAcc, Acc) -> 27 | split_lines_w_lengths(Text, 0, [], 28 | [{Length+1, lists:reverse(LineAcc, "\r")} | Acc]); 29 | split_lines_w_lengths([C | Text], Length, LineAcc, Acc) -> 30 | split_lines_w_lengths(Text, Length+1, [C | LineAcc], Acc). 31 | 32 | get_lines_info(Binary) when is_binary(Binary) -> 33 | _Lines = binary:split(Binary, [<<"\r">>, <<"\n">>, <<"\r\n">>], [global]). 34 | 35 | 36 | %% Find a line from [{Length, Line 37 | 38 | find_line_w_offset(Offset, Lines) -> 39 | find_line_w_offset(Offset, 0, 0, Lines). 40 | 41 | find_line_w_offset(0, _Pos, _N, []) -> 42 | {0, 0, 0, "", on_eof}; 43 | find_line_w_offset(_Offset, _Pos, _N, []) -> 44 | not_found; 45 | find_line_w_offset(Offset, Pos, N, [{Length, _Line} | Lines]) when Offset >= Pos+Length, Lines =/= [] -> 46 | find_line_w_offset(Offset, Pos+Length, N+1, Lines); 47 | find_line_w_offset(Offset, Pos, N, [{Length, Line} |_]) when Pos =< Offset, Offset < Pos + Length -> 48 | {N, Pos, Length, Line, false}; 49 | find_line_w_offset(Offset, Pos, N, [{Length, Line}]) -> 50 | case ends_with_newline(Line) orelse Offset > Pos + Length of 51 | true -> 52 | {N+1, Pos+Length, 0, "", beyond_eof}; 53 | false -> 54 | {N, Pos+Length, Length, Line, on_eof} 55 | end. 56 | 57 | ends_with_newline("") -> false; 58 | ends_with_newline("\n") -> true; 59 | ends_with_newline("\r") -> true; 60 | ends_with_newline("\r\n") -> true; 61 | ends_with_newline([_C | R]) -> 62 | ends_with_newline(R). 63 | 64 | -ifdef(TEST). 65 | 66 | -include_lib("eunit/include/eunit.hrl"). 67 | 68 | lines_info_test_() -> 69 | [ 70 | ?_assertEqual([<<"">>], get_lines_info(<<"">>)), 71 | ?_assertEqual([<<"abc">>], get_lines_info(<<"abc">>)), 72 | ?_assertEqual([<<"a">>,<<"b">>], get_lines_info(<<"a\nb">>)), 73 | ?_assertEqual([<<"a">>,<<"b">>,<<"c">>,<<"d">>], get_lines_info(<<"a\nb\rc\r\nd">>)), 74 | ?_assertEqual([<<"a">>,<<"">>,<<"b">>], get_lines_info(<<"a\n\rb">>)), 75 | ?_assertEqual([<<"a">>,<<"b">>], get_lines_info(<<"a\nb">>)) 76 | ]. 77 | 78 | -endif. 79 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_scanner.erl: -------------------------------------------------------------------------------- 1 | %% Author: jakob 2 | %% Created: 24 apr 2008 3 | %% Description: 4 | -module(sourcer_scanner). 5 | 6 | %% -define(DEBUG, 1). 7 | 8 | -include("debug.hrl"). 9 | -include("sourcer_token.hrl"). 10 | -include("sourcer_scanner_server.hrl"). 11 | 12 | -export([light_scan_string/2, scan_string/1, initial_scan_0/4, initial_scan/4, 13 | get_token_at/2, 14 | create/1, addref/1, dispose/1, get_text/1, 15 | get_tokens/1, get_token_window/4, 16 | dump_module/1, replace_text/4]). 17 | 18 | %% 19 | %% API Functions 20 | %% 21 | 22 | light_scan_string(B, latin1) -> 23 | S = unicode:characters_to_list(B), 24 | do_light_scan(S); 25 | light_scan_string(B, utf8) -> 26 | S = unicode:characters_to_list(B), 27 | do_light_scan(S). 28 | 29 | scan_string(B) when is_binary(B) -> 30 | scan_string(binary_to_list(B)); 31 | scan_string(L) when is_list(L) -> 32 | M = sourcer_scan_model:do_scan('', L), 33 | sourcer_scan_model:get_all_tokens(M). 34 | 35 | initial_scan_0(ScannerName, ModuleFileName, Text, _StateDir) -> 36 | RenewFun = fun(_F) -> sourcer_scan_model:do_scan(ScannerName, Text) end, 37 | RenewFun(ModuleFileName). 38 | 39 | get_token_at(ScannerName, Offset) when is_atom(ScannerName), is_integer(Offset) -> 40 | sourcer_scanner_server:server_cmd(ScannerName, get_token_at, Offset). 41 | 42 | initial_scan(ScannerName, ModuleFileName, InitialText, StateDir) 43 | when is_atom(ScannerName), is_list(ModuleFileName), is_list(InitialText), is_list(StateDir) -> 44 | sourcer_scanner_server:server_cmd(ScannerName, initial_scan, 45 | {ScannerName, ModuleFileName, InitialText, StateDir}). 46 | 47 | create(ScannerName) when is_atom(ScannerName) -> 48 | sourcer_scanner_server:spawn_server(ScannerName). 49 | 50 | addref(ScannerName) when is_atom(ScannerName) -> 51 | sourcer_scanner_server:server_cmd(ScannerName, addref). 52 | 53 | dispose(ScannerName) when is_atom(ScannerName) -> 54 | sourcer_search_server:remove_module(ScannerName), 55 | sourcer_scanner_server:server_cmd(ScannerName, dispose). 56 | 57 | get_text(ScannerName) when is_atom(ScannerName) -> 58 | sourcer_scanner_server:server_cmd(ScannerName, get_text). 59 | 60 | get_tokens(ScannerName) when is_atom(ScannerName) -> 61 | sourcer_scanner_server:server_cmd(ScannerName, get_tokens). 62 | 63 | get_token_window(ScannerName, Offset, Before, After) 64 | when is_atom(ScannerName), is_integer(Offset), is_integer(Before), is_integer(After) -> 65 | sourcer_scanner_server:server_cmd(ScannerName, get_token_window, {Offset, Before, After}). 66 | 67 | dump_module(ScannerName) when is_atom(ScannerName) -> 68 | sourcer_scanner_server:server_cmd(ScannerName, dump_module). 69 | 70 | replace_text(ScannerName, Offset, RemoveLength, NewText) 71 | when is_atom(ScannerName), is_integer(Offset), is_integer(RemoveLength), is_list(NewText) -> 72 | sourcer_scanner_server:server_cmd(ScannerName, replace_text, {Offset, RemoveLength, NewText}). 73 | 74 | %% 75 | %% Local Functions 76 | %% 77 | 78 | do_light_scan(S) -> 79 | case sourcer_scan:string(S, {0, 1}, [return]) of 80 | {ok, T, _} -> 81 | {ok, convert_tokens(T)}; 82 | {error, _, _} -> 83 | error 84 | end. 85 | 86 | -define(TOK_OTHER, 0). 87 | -define(TOK_WS, 1). 88 | -define(TOK_STR, 2). 89 | -define(TOK_ATOM, 3). 90 | -define(TOK_VAR, 4). 91 | -define(TOK_CHAR, 5). 92 | -define(TOK_MACRO, 6). 93 | -define(TOK_ARROW, 7). 94 | -define(TOK_INTEGER,8). 95 | -define(TOK_FLOAT, 9). 96 | -define(TOK_COMMENT, 10). 97 | -define(TOK_KEYWORD, 11). 98 | 99 | kind_small(ws) -> ?TOK_WS; 100 | kind_small(white_space) -> ?TOK_WS; 101 | kind_small(string) -> ?TOK_STR; 102 | kind_small(atom) -> ?TOK_ATOM; 103 | kind_small(var) -> ?TOK_VAR; 104 | kind_small(macro) -> ?TOK_MACRO; 105 | kind_small(dot) -> ?TOK_OTHER; 106 | kind_small(float) -> ?TOK_FLOAT; 107 | kind_small(integer) -> ?TOK_INTEGER; 108 | kind_small(char) -> ?TOK_CHAR; 109 | kind_small('->') -> ?TOK_ARROW; 110 | kind_small(comment) -> ?TOK_COMMENT; 111 | kind_small(Kind) when is_atom(Kind) -> 112 | case erl_scan:reserved_word(Kind) of 113 | true -> 114 | ?TOK_KEYWORD; 115 | false -> 116 | case atom_to_list(Kind) of 117 | [I] when I > ?TOK_KEYWORD -> I; 118 | _ -> ?TOK_OTHER 119 | end 120 | end. 121 | 122 | convert_tokens(Tokens) -> 123 | Fun = fun(#token{kind=Kind, line=L, offset=O, text=Txt}) -> 124 | G = case is_list(Txt) of true -> length(Txt); _ -> byte_size(Txt) end, 125 | <<(kind_small(Kind)), L:24, O:24, G:24>> 126 | end, 127 | list_to_binary(lists:flatten([Fun(X) || X <- Tokens])). 128 | 129 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_scanner_server.erl: -------------------------------------------------------------------------------- 1 | %% Author: jakob 2 | %% Created: 24 apr 2008 3 | %% Description: 4 | -module(sourcer_scanner_server). 5 | 6 | %% -define(DEBUG, 1). 7 | 8 | -include("debug.hrl"). 9 | -include("sourcer_scanner_server.hrl"). 10 | 11 | -export([server_cmd/2, server_cmd/3, 12 | spawn_server/1]). 13 | 14 | %% stop/0 15 | 16 | %% internal exports 17 | -export([loop/2]). 18 | 19 | %% 20 | %% API Functions 21 | %% 22 | 23 | server_cmd(ScannerName, Command) -> 24 | server_cmd(ScannerName, Command, []). 25 | 26 | server_cmd(ScannerName, Command, Args) -> 27 | ScannerName ! {Command, self(), Args}, 28 | receive 29 | {Command, _Pid, Result} -> 30 | Result 31 | end. 32 | 33 | spawn_server(ScannerName) -> 34 | case whereis(ScannerName) of 35 | undefined -> 36 | Pid = spawn(fun() -> 37 | erlang:process_flag(save_calls, 50), 38 | erlang:process_flag(min_heap_size, 64*1024), 39 | loop(#module{name=ScannerName}, 0) 40 | end), 41 | erlang:register(ScannerName, Pid); 42 | _ -> 43 | ok 44 | end, 45 | server_cmd(ScannerName, addref, []), 46 | ok. 47 | 48 | %% 49 | %% Local Functions 50 | %% 51 | 52 | loop(Module, Refs) -> 53 | receive 54 | {addref, From, []} -> 55 | ?D({addref, Module#module.name}), 56 | reply(addref, From, ok), 57 | ?MODULE:loop(Module, Refs+1); 58 | {dispose, From, []} -> 59 | ?D({dispose, Module#module.name}), 60 | reply(dispose, From, ok), 61 | case Refs=<1 of 62 | true -> 63 | ok; 64 | _ -> 65 | ?MODULE:loop(Module, Refs-1) 66 | end; 67 | {Cmd, From, Args} -> 68 | NewModule = cmd(Cmd, From, Args, Module), 69 | ?MODULE:loop(NewModule, Refs); 70 | Msg -> 71 | %sourcer_log:log({scanner, Module#module.name, unexpected_message, Msg}), 72 | ?MODULE:loop(Module, Refs) 73 | end. 74 | 75 | cmd(Cmd, From, Args, Module) -> 76 | try 77 | case do_cmd(Cmd, Args, Module) of 78 | {R, NewModule} -> 79 | reply(Cmd, From, R), 80 | NewModule; 81 | NewModule -> 82 | reply(Cmd, From, ok), 83 | NewModule 84 | end 85 | catch 86 | exit:Error -> 87 | reply(Cmd, From, {exit, Error}), 88 | Module; 89 | error:Error -> 90 | reply(Cmd, From, {error, Error}), 91 | Module 92 | end. 93 | 94 | reply(Cmd, From, R) -> 95 | From ! {Cmd, self(), R}. 96 | 97 | do_cmd(initial_scan, {ScannerName, ModuleFileName, InitialText, StateDir}, _Module) -> 98 | ?D({initial_scan, ScannerName, length(InitialText)}), 99 | Module1 = sourcer_scanner:initial_scan_0(ScannerName, ModuleFileName, InitialText, StateDir), 100 | {ok, Module1}; 101 | do_cmd(dump_module, [], Module) -> 102 | {Module, Module}; 103 | do_cmd(get_token_at, Offset, Module) -> 104 | {sourcer_scan_model:get_token_at(Module, Offset), Module}; 105 | do_cmd(replace_text, {Offset, RemoveLength, NewText}, Module) -> 106 | ?D({replace_text, Offset, RemoveLength, length(NewText)}), 107 | sourcer_scan_model:replace_text(Module, Offset, RemoveLength, NewText); 108 | do_cmd(get_text, [], Module) -> 109 | {sourcer_scan_model:get_text(Module), Module}; 110 | do_cmd(get_tokens, [], Module) -> 111 | {sourcer_scan_model:get_all_tokens(Module), Module}; 112 | do_cmd(get_token_window, {Offset, Before, After}, Module) -> 113 | {sourcer_scan_model:get_token_window(Module, Offset, Before, After), Module}. 114 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_search.erl: -------------------------------------------------------------------------------- 1 | %% @author jakob 2 | %% the functional part of searching 3 | 4 | -module(sourcer_search). 5 | 6 | %% -define(DEBUG, 1). 7 | 8 | -include("debug.hrl"). 9 | -include("include/sourcer_search.hrl"). 10 | 11 | -export([find_data/4]). 12 | 13 | %% 14 | %% API Functions 15 | %% 16 | 17 | find_data(Refs, Pattern, ModuleAtom, ModuleName) -> 18 | find_data(Refs, Pattern, ModuleAtom, ModuleName, []). 19 | 20 | %% 21 | %% Local Functions 22 | %% 23 | 24 | find_data([], _, _, _, Acc) -> 25 | Acc; 26 | find_data([#ref{function=F, arity=A, clause=C, data=D, offset=O, length=L, sub_clause=S} | Rest], 27 | Pattern, Mod, M, Acc) -> 28 | NewAcc = case check_pattern(Pattern, Mod, D, F, A, C) of 29 | true -> 30 | [{M, F, A, C, S, O, L, is_def(D)} | Acc]; 31 | false -> 32 | Acc 33 | end, 34 | find_data(Rest, Pattern, Mod, M, NewAcc). 35 | 36 | %% is_def(Ref) returns true if the ref is a definition 37 | is_def(#function_def{}) -> true; 38 | is_def(#macro_def{}) -> true; 39 | is_def(#type_def{}) -> true; 40 | is_def(#module_def{}) -> true; 41 | is_def(#var_def{}) -> true; 42 | is_def(#record_field_def{}) -> true; 43 | is_def(_) -> false. 44 | 45 | check_pattern(Pattern, Mod, #local_call{function=F, arity=A}, _, _, _)-> 46 | check_function_ref(#external_call{module=Mod, function=F, arity=A}, Pattern); 47 | check_pattern(Pattern, Mod, #function_def{function=F, arity=A} = FD, _, _, _)-> 48 | check_function_ref(FD, Pattern) orelse 49 | check_function_ref(#function_def_mod{module=Mod, function=F, arity=A}, Pattern); 50 | check_pattern(Pattern, Mod, #type_ref{module='_', type=T}, _, _, _) -> 51 | lists:member(#type_ref{module=Mod, type=T}, Pattern); 52 | check_pattern(Pattern, _Mod, #var_ref{}=VR, F, A, C) -> 53 | check_var_pattern(Pattern, VR, F, A, C); 54 | check_pattern(Pattern, _Mod, #var_def{}=VD, F, A, C) -> 55 | check_var_pattern(Pattern, VD, F, A, C); 56 | check_pattern(Pattern, _Mod, D, _, _, _) -> 57 | lists:member(D, Pattern). 58 | 59 | check_function_ref(_, []) -> 60 | false; 61 | check_function_ref(#external_call{module=Mod, function=F, arity=A1}, [#external_call{module=Mod, function=F, arity=A2}|_]) -> 62 | A1==A2 orelse A2==undefined; 63 | check_function_ref(#function_def{function=F, arity=A1}, [#function_def{function=F, arity=A2}|_]) -> 64 | A1==A2 orelse A2==undefined; 65 | check_function_ref(#function_def_mod{module=Mod, function=F, arity=A1}, [#function_def_mod{module=Mod, function=F, arity=A2}|_]) -> 66 | A1==A2 orelse A2==undefined; 67 | check_function_ref(X, [_|Tail]) -> 68 | check_function_ref(X, Tail). 69 | 70 | 71 | 72 | check_var_pattern([], _, _, _, _) -> 73 | false; 74 | check_var_pattern([#var_pattern{vardefref=VL, function=F, arity=A, clause=C} | Rest], V, F, A, C) -> 75 | ?D({VL, F, A, C}), 76 | case lists:member(V, VL) of 77 | true -> true; 78 | false -> check_var_pattern(Rest, V, F, A, C) 79 | end; 80 | check_var_pattern([#var_pattern{vardefref=VL, function='', arity=-1, clause=""} | Rest], V, F, A, C) -> 81 | ?D({VL, F, A, C}), 82 | case lists:member(V, VL) of 83 | true -> true; 84 | false -> check_var_pattern(Rest, V, F, A, C) 85 | end; 86 | check_var_pattern([_ | Rest], V, F, A, C) -> 87 | check_var_pattern(Rest, V, F, A, C). 88 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_types.erl: -------------------------------------------------------------------------------- 1 | %%% ****************************************************************************** 2 | %%% Copyright (c) 2009 Vlad Dumitrescu and others. 3 | %%% All rights reserved. This program and the accompanying materials 4 | %%% are made available under the terms of the Eclipse Public License v1.0 5 | %%% which accompanies this distribution, and is available at 6 | %%% http://www.eclipse.org/legal/epl-v10.html 7 | %%% 8 | %%% Contributors: 9 | %%% Vlad Dumitrescu 10 | %%% ******************************************************************************/ 11 | %%% 12 | %%% The DB contains info about the source locations of relevant code constructs. 13 | %%% It is kind of like a ctags DB, but has more information. 14 | %%% 15 | -module(sourcer_types). 16 | 17 | -export([ 18 | definition/2, 19 | reference/3 20 | ]). 21 | 22 | -export_type([ 23 | range/0, 24 | file_key/0, 25 | file_props/0, 26 | 27 | edefinition/0, 28 | ereference/0 29 | ]). 30 | 31 | %-type kind() :: 'module' | 'include' | 'function' | 'macro' | 'record' | 'field' | 'variable' | 'type' | 'ifdef'. 32 | -type range() :: {Line::integer(), Column::integer(), Offset::integer()} | 'undefined'. 33 | 34 | -define(COMMON_PROPS, keyRange := range(), defRange := range()). 35 | 36 | -type file_key() :: #{kind:='file', location:=string()}. 37 | -type file_props() :: #{is_library:=boolean(), 38 | ?COMMON_PROPS 39 | }. 40 | 41 | -type module_key() :: #{kind:='module', name:=atom()}. 42 | -type module_props() :: #{file:=file_key(), includes:=[file_key()], 43 | ?COMMON_PROPS 44 | }. 45 | 46 | -type include_key() :: #{file:=file_key(), target:=file_key()}. 47 | -type include_props() :: #{is_library:=boolean(), 48 | ?COMMON_PROPS 49 | }. 50 | 51 | -type function_key() :: #{kind:='function', module:=module_key(), name:=atom(), arity:=integer()}. 52 | -type function_props() :: #{is_exported:=boolean(), 53 | ?COMMON_PROPS 54 | }. 55 | 56 | -type type_key() :: #{kind:='type', module:=module_key(), name:=atom(), arity:=integer()}. 57 | -type type_props() :: #{is_exported:=boolean(), 58 | ?COMMON_PROPS 59 | }. 60 | 61 | -type macro_key() :: #{kind:='macro', file:=file_key(), name:=string(), arity:=integer()}. 62 | -type macro_props() :: #{ 63 | ?COMMON_PROPS 64 | }. 65 | 66 | -type record_key() :: #{kind:='record', file:=file_key(), name:=string()}. 67 | -type record_props() :: #{ 68 | ?COMMON_PROPS 69 | }. 70 | 71 | -type field_key() :: #{kind:='field', record:=record_key(), name:=string()}. 72 | -type field_props() :: #{ 73 | ?COMMON_PROPS 74 | }. 75 | 76 | -type parent_key() :: function_key() | macro_key(). 77 | -type variable_key() :: #{kind:='variable', parent:=parent_key(), name:=string(), index:=integer()}. 78 | -type variable_props() :: #{ 79 | ?COMMON_PROPS 80 | }. 81 | 82 | -type ifdef_key() :: #{kind:='ifdef', file:=file_key(), condition:=macro_key(), index:=integer()}. 83 | -type ifdef_props() :: #{if_range:=range(), else_range:=range(), 84 | ?COMMON_PROPS}. 85 | 86 | 87 | -type key() :: file_key() | module_key() | include_key() | function_key() | type_key() 88 | | macro_key() | record_key() | field_key() | variable_key() | ifdef_key(). 89 | 90 | 91 | -type props() :: file_props() | module_props() | include_props() | function_props() | type_props() 92 | | macro_props() | record_props() | field_props() | variable_props() | ifdef_props(). 93 | 94 | -record(definition, { 95 | key :: key(), 96 | props :: props() 97 | }). 98 | 99 | -record(reference, { 100 | key :: key(), 101 | file :: file_key(), 102 | range :: range() 103 | }). 104 | 105 | -type edefinition() :: #definition{}. 106 | -type ereference() :: #reference{}. 107 | 108 | definition(Key, Props) -> 109 | #definition{key=Key, props=Props}. 110 | 111 | reference(Key, File, Range) -> 112 | #reference{key=Key, file=File, range=Range}. 113 | 114 | -------------------------------------------------------------------------------- /apps/sourcer/src2/sourcer_xref.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_xref). 2 | 3 | -export([start/0, 4 | stop/0, 5 | add_project/1, 6 | add_dirs/1, 7 | analyze/1, 8 | function_call/1, 9 | function_use/1, 10 | function_call/3, 11 | function_use/3, 12 | modules/0, 13 | module_call/1, 14 | module_use/1, 15 | update/0]). 16 | 17 | %-define(DEBUG, 1). 18 | 19 | -define(XREF, sourcer_xref). 20 | 21 | 22 | -include("debug.hrl"). 23 | 24 | start() -> 25 | start(whereis(?XREF)). 26 | 27 | start(undefined) -> 28 | %% spawn(fun() -> 29 | erlang:process_flag(save_calls, 50), 30 | erlang:yield(), 31 | xref:start(?XREF), 32 | xref:set_default(?XREF, [{verbose,false},{warnings,false}]), 33 | %% X= xref:add_release(sourcer, code:lib_dir(), 34 | %% [{name, otp}]), 35 | %% ok 36 | %% end), 37 | ok; 38 | start(_) -> 39 | ok. 40 | 41 | stop() -> 42 | xref:stop(?XREF). 43 | 44 | add_project(ProjectDir) -> 45 | R=xref:add_application(?XREF, ProjectDir), 46 | R. 47 | 48 | add_dirs([]) -> 49 | ok; 50 | add_dirs([BeamDir | Rest]) -> 51 | start(), 52 | update(), 53 | ?D(BeamDir), 54 | case xref:add_directory(?XREF, BeamDir, [{recurse, false}]) of 55 | {ok, _} = _R -> 56 | ?D(_R), 57 | add_dirs(Rest); 58 | {error, xref_base, {module_clash, _}} -> 59 | add_dirs(Rest); 60 | Error -> 61 | ?D(Error), 62 | Error 63 | end. 64 | 65 | %% add_dir(BeamDir) -> 66 | %% start(), 67 | %% R = xref:add_directory(?XREF, BeamDir), 68 | %% ?D(R), 69 | %% R. 70 | 71 | update() -> 72 | start(), 73 | xref:update(?XREF, []). 74 | 75 | modules() -> 76 | start(), 77 | xref:q(?XREF, "M"). 78 | 79 | analyze(Module) when is_atom(Module) -> 80 | start(), 81 | xref:m(Module); 82 | analyze(Dir) when is_list(Dir) -> 83 | start(), 84 | xref:d(Dir). 85 | 86 | module_use(Module) when is_atom(Module) -> 87 | start(), 88 | xref:analyze(?XREF, {module_use, Module}). 89 | 90 | module_call(Module) when is_atom(Module) -> 91 | start(), 92 | xref:analyze(?XREF, {module_call, Module}). 93 | 94 | function_use({M, F, A}) when is_atom(M), is_atom(F), is_integer(A) -> 95 | start(), 96 | xref:analyze(?XREF, {use, [{M, F, A}]}, []). 97 | 98 | function_use(M, F, A) -> 99 | function_use({M, F, A}). 100 | 101 | function_call({M, F, A}) when is_atom(M), is_atom(F), is_integer(A) -> 102 | xref:analyze(?XREF, {call, {M, F, A}}). 103 | 104 | function_call(M, F, A) when is_atom(M), is_atom(F), is_integer(A) -> 105 | xref:analyze(?XREF, {call, {M, F, A}}). 106 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/comments: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% 3 comment chars: always left indented 5 | %%% 2 comment chars: Context indented 6 | %%% 1 comment char: Rigth indented 7 | 8 | %%% left 9 | %% context dependent 10 | % rigth 11 | 12 | func() -> 13 | %%% left 14 | %% context dependent 15 | % right indented 16 | case get(foo) of 17 | undefined -> 18 | %% Testing indention 19 | ok; 20 | %% Catch all 21 | Other -> 22 | Other 23 | end, 24 | ok. 25 | % after funktion 26 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/comprehensions: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% indentation of comprehensions 5 | 6 | %%% Not everything in these test are set in stone 7 | %%% better indentation rules can be added but by having 8 | %%% these tests we can see what changes in new implementations 9 | %%% and notice when doing unintentional changes 10 | 11 | list() -> 12 | %% I don't have a good idea how we want to handle this 13 | %% but they are here to show how they are indented today. 14 | Result1 = [X || 15 | #record{a=X} <- lists:seq(1, 10), 16 | true = (X rem 2) 17 | ], 18 | Result2 = [X || <> <= <<0:512>>, 19 | true = (X rem 2) 20 | ], 21 | Res = [ func(X, 22 | arg2) 23 | || 24 | #record{a=X} <- lists:seq(1, 10), 25 | true = (X rem 2) 26 | ], 27 | Result1. 28 | 29 | binary(B) -> 30 | Binary1 = << <> || 31 | #record{a=X} <- lists:seq(1, 10), 32 | true = (X rem 2) 33 | >>, 34 | 35 | Binary2 = << <> || <> <= <<0:512>>, 36 | true = (X rem 2) 37 | >>, 38 | 39 | Bin3 = << 40 | << 41 | X:8, 42 | 34:8 43 | >> 44 | || <> <= <<0:512>>, 45 | true = (X rem 2) 46 | >>, 47 | ok. 48 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/errors: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | %% 3 | %% Test different parse or syntax errors. 4 | %% 5 | 6 | %% This one caused an eternal loop in the parser 7 | forever(1) -> 8 | foo 9 | end. 10 | 11 | 12 | %% Check that we can handle scanner errors in some way 13 | 14 | scanner_errors() -> 15 | Float = 6.28e1, 16 | HalfFinishedFloat = 2.3e, 17 | ok. 18 | 19 | %% This needs to be last: uncompleted string 20 | 21 | uncomplete() -> 22 | foo(), 23 | UntilEof = "1 24 | 2 25 | 3 26 | ok. 27 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/exprs: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% indentation of exprs 5 | 6 | %%% Not everything in these test are set in stone 7 | %%% better indentation rules can be added but by having 8 | %%% these tests we can see what changes in new implementations 9 | %%% and notice when doing unintentional changes 10 | 11 | 12 | 13 | f1() -> 14 | Var = [ a, 15 | b 16 | | c], 17 | [ a1, 18 | some_func(b) 19 | | Var]. 20 | 21 | bin_op({{Y,Mo,D},{H,Mi,S}}) -> 22 | erlang:display_string( 23 | integer_to_list(Y) ++ "-" ++ 24 | two_digits(Mo) ++ "-" ++ 25 | two_digits(D) ++ " " ++ 26 | two_digits(H) ++ ":" ++ 27 | two_digits(Mi) ++ ":" ++ 28 | two_digits(S) ++ " "). 29 | 30 | 31 | double_match() -> 32 | LongExpr = A = 33 | foo, 34 | VarA =:= VarB orelse 35 | VarC =:= VarD orelse 36 | VarE =:= VarD. 37 | 38 | 39 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/funcs: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% Function (and funs) indentation 5 | 6 | %%% Not everything in these test are set in stone 7 | %%% better indentation rules can be added but by having 8 | %%% these tests we can see what changes in new implementations 9 | %%% and notice when doing unintentional changes 10 | 11 | -export([ 12 | func1/0, 13 | func2/0, 14 | a_function_with_a_very_very_long_name/0, 15 | when1/2 16 | ]). 17 | 18 | -compile([nowarn_unused_functions, 19 | {inline, [ 20 | func2/2, 21 | func3/2 22 | ] 23 | } 24 | ]). 25 | 26 | func1() -> 27 | basic. 28 | 29 | func2(A1, 30 | A2) -> 31 | ok. 32 | 33 | func3( 34 | A1, 35 | A2 36 | ) -> 37 | ok. 38 | 39 | %% Okeefe style 40 | func4(A1 41 | ,A2 42 | ,A3 43 | ) -> 44 | ok. 45 | 46 | func5( 47 | A41 48 | ,A42) -> 49 | ok. 50 | 51 | a_function_with_a_very_very_long_name() -> 52 | A00 = #record{ 53 | field1=1, 54 | field2=1 55 | }, 56 | A00. 57 | directly_after() -> 58 | ok. 59 | 60 | when1(W1, W2) 61 | when is_number(W1), 62 | is_number(W2) -> 63 | ok. 64 | 65 | when2(W1,W2,W3) when 66 | W1 > W2, 67 | W2 > W3 -> 68 | ok. 69 | 70 | when3(W1,W2,W3) when 71 | W1 > W2, 72 | W2 > W3 73 | -> 74 | ok. 75 | 76 | when4(W1,W2,W3) 77 | when 78 | W1 > W2, 79 | W2 > W3 -> 80 | ok. 81 | 82 | when5(W1,W2,W3) 83 | when 84 | W1 > W2 orelse 85 | W2 > W3 -> 86 | ok. 87 | 88 | match1({[H|T], 89 | Other}, 90 | M1A2) -> 91 | ok. 92 | 93 | match2( 94 | { 95 | [H|T], 96 | Other 97 | }, 98 | M2A2 99 | ) -> 100 | ok. 101 | 102 | match3({ 103 | M3A1, 104 | [ 105 | H | 106 | T 107 | ], 108 | Other 109 | }, 110 | M3A2 111 | ) -> 112 | ok. 113 | 114 | match4(<< 115 | M4A:8, 116 | M4B:16/unsigned-integer, 117 | _/binary 118 | >>, 119 | M4C) -> 120 | ok. 121 | 122 | match5(M5A, 123 | #record{ 124 | b=M5B, 125 | c=M5C 126 | } 127 | ) -> 128 | ok. 129 | 130 | match6(M6A, 131 | #{key6a := a6, 132 | key6b := b6 133 | }) -> 134 | ok. 135 | 136 | funs(1) 137 | when 138 | X -> 139 | %% Changed fun to one indention level 140 | %% 'when' and several clause forces a depth of '4' 141 | Var = spawn(fun(X, _) 142 | when X == 2; 143 | X > 10 -> 144 | hello, 145 | case Hello() of 146 | true when is_atom(X) -> 147 | foo; 148 | false -> 149 | bar 150 | end; 151 | (Foo) when is_atom(Foo), 152 | is_integer(X) -> 153 | X = 6 * 45, 154 | Y = true andalso 155 | kalle 156 | end), 157 | Var; 158 | funs(2) -> 159 | %% check EEP37 named funs 160 | Fn1 = fun 161 | Factory(N) when 162 | N > 0 -> 163 | F = Fact(N-1), 164 | N * F; 165 | Factory(0) -> 166 | 1 167 | end, 168 | Fn1; 169 | funs(3) -> 170 | %% check anonymous funs too 171 | Fn2 = fun(0) -> 172 | 1; 173 | (N) -> 174 | N 175 | end, 176 | ok; 177 | funs(4) -> 178 | X = lists:foldr(fun(M) -> 179 | <> 180 | end, [], Z), 181 | A = <>, 182 | A. 183 | 184 | function() -> 185 | call_another 186 | (X, 187 | Y). 188 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/highlight: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% Open this file in your editor and manually check the colors of 5 | %%% different types and calls and builtin words 6 | 7 | %%% Not everything in these test are set in stone 8 | %%% better indentation rules can be added but by having 9 | %%% these tests we can see what changes in new implementations 10 | %%% and notice when doing unintentional changes 11 | 12 | 13 | highlighting(X) % Function definitions should be highlighted 14 | when is_integer(X) -> % and so should `when' and `is_integer' be 15 | %% Highlighting 16 | %% Various characters (we keep an `atom' after to see that highlighting ends) 17 | $a,atom, % Characters should be marked 18 | "string",atom, % and strings 19 | 'asdasd',atom, % quote should be atoms?? 20 | 'VaV',atom, 21 | 'aVa',atom, 22 | '\'atom',atom, 23 | 'atom\'',atom, 24 | 'at\'om',atom, 25 | '#1',atom, 26 | 27 | $", atom, % atom should be ok 28 | $', atom, 29 | 30 | "string$", atom, "string$", atom, % currently buggy I know... 31 | "string\$", atom, % workaround for bug above 32 | 33 | "char $in string", atom, 34 | 35 | 'atom$', atom, 'atom$', atom, 36 | 'atom\$', atom, 37 | 38 | 'char $in atom', atom, 39 | 40 | $[, ${, $\\, atom, 41 | ?MACRO_1, 42 | ?MACRO_2(foo), 43 | 44 | %% Numerical constants 45 | 16#DD, % Should not be highlighted 46 | 32#dd, % Should not be highlighted 47 | 32#ddAB, % Should not be highlighted 48 | 32#101, % Should not be highlighted 49 | 32#ABTR, % Should not be highlighted 50 | 51 | %% Variables 52 | Variables = lists:foo(), 53 | _Variables = lists:foo(), 54 | AppSpec = Xyz/2, 55 | Module42 = Xyz(foo, bar), 56 | Module:foo(), 57 | _Module:foo(), % 58 | FooÅÅ = lists:reverse([tl,hd,tl,hd]), % Should highlight FooÅÅ 59 | _FooÅÅ = 42, % Should highlight _FooÅÅ 60 | 61 | %% Bifs 62 | erlang:registered(), 63 | registered(), 64 | hd(tl(tl(hd([a,b,c])))), 65 | erlang:anything(lists), 66 | %% Guards 67 | is_atom(foo), is_float(2.3), is_integer(32), is_number(4323.3), 68 | is_function(Fun), is_pid(self()), 69 | not_a_guard:is_list([]), 70 | %% Other Types 71 | 72 | atom, % not (currently) hightlighted 73 | 234234, 74 | 234.43, 75 | 76 | [list, are, 'not', higlighted], 77 | {nor, is, tuple}, 78 | ok. 79 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/icr: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% indentation of if case receive statements 5 | 6 | %%% Not everything in these test are set in stone 7 | %%% better indentation rules can be added but by having 8 | %%% these tests we can see what changes in new implementations 9 | %%% and notice when doing unintentional changes 10 | 11 | indent_if(1, Z) -> 12 | %% If 13 | if Z >= 0 -> 14 | X = 43 div Z, 15 | X; 16 | Z =< 10 -> 17 | X = 43 div Z, 18 | X; 19 | Z == 5 orelse 20 | Z == 7 -> 21 | X = 43 div Z, 22 | X; 23 | is_number(Z), 24 | Z < 32 -> 25 | Z; 26 | is_number(Z); 27 | Z < 32 -> 28 | Z * 32; 29 | true -> 30 | if_works 31 | end; 32 | indent_if(2, Z) -> 33 | %% If 34 | if 35 | Z >= 0 -> 36 | X = 43 div Z, 37 | X 38 | ; Z =< 10 -> 39 | 43 div Z 40 | ; Z == 5 orelse 41 | Z == 7 -> 42 | X = 43 div Z, 43 | X 44 | ; is_number(Z), 45 | Z < 32 -> 46 | Z 47 | ; true -> 48 | if_works 49 | end. 50 | 51 | indent_case(1, Z) -> 52 | %% Case 53 | case {Z, foo, bar} of 54 | {Z,_,_} -> 55 | X = 43 div 4, 56 | foo(X); 57 | {Z,_,_} when 58 | Z =:= 42 -> % line should be indented as a when 59 | X = 43 div 4, 60 | foo(X); 61 | {Z,_,_} 62 | when Z < 10 orelse 63 | Z =:= foo -> 64 | X = 43 div 4, 65 | Bool = Z < 5 orelse % Emacs Binary op args align differently after when 66 | Z =:= foo, 67 | foo(X); 68 | {Z,_,_} 69 | when % when should be indented 70 | Z < 10 % and the guards should follow when 71 | andalso % unsure about how though 72 | true -> 73 | X = 43 div 4, 74 | foo(X) 75 | end; 76 | indent_case(2, Z) -> 77 | %% Case 78 | case {Z, foo, bar} of 79 | {Z,_,_} -> 80 | X = 43 div 4, 81 | foo(X) 82 | ; {Z,_,_} when 83 | Z =:= 42 -> % line should be indented as a when 84 | X = 43 div 4, 85 | foo(X) 86 | ; {Z,_,_} 87 | when Z < 10 -> % when should be indented 88 | X = 43 div 4, 89 | foo(X) 90 | ; {Z,_,_} 91 | when % when should be indented 92 | Z < 10 % and the guards should follow when 93 | andalso % unsure about how though 94 | true -> 95 | X = 43 div 4, 96 | foo(X) 97 | end. 98 | 99 | indent_begin(Z) -> 100 | %% Begin 101 | begin 102 | sune, 103 | Z = 74234 + 104 | foo(8456) + 105 | 345 div 43, 106 | Foo = begin 107 | ok, 108 | foo(234), 109 | begin 110 | io:format("Down here\n") 111 | end 112 | end, 113 | {Foo, 114 | bar} 115 | end. 116 | 117 | indent_receive(1) -> 118 | %% receive 119 | receive 120 | {Z,_,_} -> 121 | X = 43 div 4, 122 | foo(X) 123 | ; Z -> 124 | X = 43 div 4, 125 | foo(X) 126 | end, 127 | ok; 128 | indent_receive(2) -> 129 | receive 130 | {Z,_,_} -> 131 | X = 43 div 4, 132 | foo(X); 133 | Z % added clause 134 | when Z =:= 1 -> % This line should be indented by 2 135 | X = 43 div 4, 136 | foo(X); 137 | Z when % added clause 138 | Z =:= 2 -> % This line should be indented by 2 139 | X = 43 div 4, 140 | foo(X); 141 | Z -> 142 | X = 43 div 4, 143 | foo(X) 144 | after 145 | infinity -> 146 | foo(X), 147 | asd(X), 148 | 5*43 149 | end, 150 | ok; 151 | indent_receive() -> 152 | MyResult = receive 153 | after 10 -> 154 | foo(X), 155 | asd(X), 156 | 5*43 157 | end, 158 | ok. 159 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/macros: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% Macros should be indented as code 5 | 6 | -export([ 7 | ] 8 | ). 9 | 10 | -define(M0, ok). 11 | 12 | -define(M1, 13 | case X of 14 | undefined -> error; 15 | _ -> ok 16 | end). 17 | 18 | -define(M2(M2A1, 19 | M2A2), 20 | func(M2A1, 21 | M2A2) 22 | ). 23 | 24 | -define( 25 | M3, 26 | undefined 27 | ). 28 | 29 | -ifdef(DEBUG). 30 | -define(LOG, 31 | logger:log(?MODULE,?LINE) 32 | ). 33 | -else(). 34 | -define(LOG, ok). 35 | -endif(). 36 | 37 | -define(PARSE_XML_DECL(Bytes, State), 38 | parse_xml_decl(Bytes, #xmerl_sax_parser_state{encoding=Enc} = State) 39 | when is_binary(Bytes) -> 40 | case unicode:characters_to_list(Bytes, Enc) of 41 | {incomplete, _, _} -> 42 | cf(Bytes, State, fun parse_xml_decl/2); 43 | {error, _Encoded, _Rest} -> 44 | ?fatal_error(State, "Bad character"); 45 | _ -> 46 | parse_prolog(Bytes, State) 47 | end; 48 | parse_xml_decl(Bytes, State) -> 49 | parse_prolog(Bytes, State)). 50 | 51 | 52 | -define(fatal(Reason, S), 53 | if 54 | S#record.quiet -> 55 | ok; 56 | true -> 57 | error_logger:error_msg("~p- fatal: ~p~n", [?LINE, Reason]), 58 | ok 59 | end, 60 | fatal(Reason, S)). 61 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/records: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %% Test that records are indented correctly 5 | 6 | -record(record0, 7 | { 8 | r0a, 9 | r0b, 10 | r0c 11 | }). 12 | 13 | -record(record1, {r1a, 14 | r1b, 15 | r1c 16 | }). 17 | 18 | -record(record2, { 19 | r2a, 20 | r2b 21 | }). 22 | 23 | -record(record3, {r3a = 8#42423 bor 24 | 8#4234, %% differ emacs 25 | r3b = 8#5432 26 | bor 2#1010101, %% differ emacs 27 | r3c = 123 + 28 | 234, %% differ emacs 29 | r3d}). 30 | 31 | -record(record5, 32 | { r5a = 1 :: integer() 33 | , r5b = foobar :: atom() 34 | }). 35 | 36 | 37 | record_usage(A) -> 38 | %% Test parser 39 | A = bnot (id())#record_usage.r5a, 40 | Bool = Parms#?HASH_PARMS.bchunk_format_version =:= 41 | ?BCHUNK_FORMAT_VERSION, 42 | {ok, A, Bool}. 43 | 44 | record_usage(Argument) -> 45 | B0 = Argument#record_usage 46 | {field1 = 47 | foo}, 48 | B0 = Argument#record_usage{ 49 | field1 = 50 | foo}, 51 | 52 | {ok, B}. 53 | 54 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/terms: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% indentation of terms contain builtin types 5 | 6 | %%% Not everything in these test are set in stone 7 | %%% better indentation rules can be added but by having 8 | %%% these tests we can see what changes in new implementations 9 | %%% and notice when doing unintentional changes 10 | 11 | 12 | list(1) -> 13 | [a, 14 | b, 15 | c 16 | ]; 17 | list(2) -> 18 | [ a, 19 | b, c 20 | ]; 21 | list(3) -> 22 | [ 23 | a, 24 | b, c 25 | ]; 26 | list(4) -> 27 | [ a 28 | , b 29 | , c 30 | ]. 31 | 32 | tuple(1) -> 33 | {a, 34 | b,c 35 | }; 36 | tuple(2) -> 37 | { a, 38 | b,c 39 | }; 40 | tuple(3) -> 41 | { 42 | a, 43 | b,c 44 | }; 45 | tuple(4) -> 46 | { a 47 | , b 48 | ,c 49 | }. 50 | 51 | binary(1) -> 52 | <<1:8/unsigned-native, 53 | 2:8 54 | >>; 55 | binary(2) -> 56 | << 57 | 1:8, 58 | 2:8 59 | >>; 60 | binary(3) -> 61 | << 1:8, 62 | 2:8 63 | >>; 64 | binary(4) -> 65 | << 66 | 1:8 67 | ,2:8 68 | >>; 69 | binary(5) -> 70 | << 1:8 71 | , 2:8 72 | , ?macro1():?macro2() 73 | >>; 74 | binary(6) -> 75 | <<0.0:32/float>>; 76 | 77 | record(1) -> 78 | #record{a=1, 79 | b=2 80 | }; 81 | record(2) -> 82 | #record{ a=1, 83 | b=2 84 | }; 85 | record(3) -> 86 | #record{ 87 | a=1, 88 | b=2 89 | }; 90 | record(4) -> 91 | #record{ 92 | a=1 93 | ,b=2 94 | }; 95 | record(Record) -> 96 | Record#record{ 97 | a=1 98 | ,b=2 99 | }. 100 | 101 | map(1) -> 102 | #{a=>1, 103 | b=>2 104 | }; 105 | map(2) -> 106 | #{ a=>1, 107 | b=>2 108 | }; 109 | map(3) -> 110 | #{ 111 | a=>1, 112 | b=>2 113 | }; 114 | map(4) -> 115 | #{ 116 | a => <<"a">> 117 | ,b => 2 118 | }; 119 | map(MapVar) -> 120 | MapVar = #{a :=<<"a">> 121 | ,b:=1}. 122 | 123 | deep(Rec) -> 124 | Rec#rec{ atom = 'atom', 125 | map = #{ k1 => {v, 126 | 1}, 127 | k2 => [ 128 | 1, 129 | 2, 130 | 3 131 | ], 132 | {key, 133 | 3} 134 | => 135 | << 136 | 123:8, 137 | 255:8 138 | >> 139 | } 140 | }. 141 | 142 | %% Record indentation 143 | some_function_with_a_very_long_name() -> 144 | #'a-long-record-name-like-it-sometimes-is-with-asn.1-records'{ 145 | field1=a, 146 | field2=b}, 147 | case dummy_function_with_a_very_very_long_name(x) of 148 | #'a-long-record-name-like-it-sometimes-is-with-asn.1-records'{ 149 | field1=a, 150 | field2=b} -> 151 | ok; 152 | Var = #'a-long-record-name-like-it-sometimes-is-with-asn.1-records'{ 153 | field1=a, 154 | field2=b} -> 155 | Var#'a-long-record-name-like-it-sometimes-is-with-asn.1-records'{ 156 | field1=a, 157 | field2=b}; 158 | #xyz{ 159 | a=1, 160 | b=2} -> 161 | ok 162 | end. 163 | 164 | some_function_name_xyz(xyzzy, #some_record{ 165 | field1=Field1, 166 | field2=Field2}) -> 167 | SomeVariable = f(#'Some-long-record-name'{ 168 | field_a = 1, 169 | 'inter-xyz-parameters' = 170 | #'Some-other-very-long-record-name'{ 171 | field2 = Field1, 172 | field2 = Field2}}), 173 | {ok, SomeVariable}. 174 | 175 | foo() -> 176 | [#foo{ 177 | foo = foo}]. 178 | 179 | list_string() -> 180 | ListString = "sune L" 181 | "kalle L" 182 | "oskar L", 183 | {ok, ListString}. 184 | 185 | binary_string() -> 186 | BinString = <<"sune B" 187 | "kalle B" 188 | "oskar B"/binary>>, 189 | {ok, BinString}. 190 | 191 | a_string_with_nl() -> 192 | Str = "row1\nrow2\nrow3\n", 193 | ok. 194 | 195 | ml_string() -> 196 | ListString = "row 1L 197 | row 2L 198 | row 3L", 199 | {ok, ListString}. 200 | 201 | bin_ml_string() -> 202 | ListString = <<"row 1B 203 | row 2B 204 | row 3B">>, 205 | {ok, ListString}. 206 | 207 | 208 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/try_catch: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %%% Try and catch indentation is hard 5 | 6 | %%% Not everything in these test are set in stone 7 | %%% better indentation rules can be added but by having 8 | %%% these tests we can see what changes in new implementations 9 | %%% and notice when doing unintentional changes 10 | 11 | try_catch() -> 12 | try 13 | io:format(stdout, "Parsing file ~s, ", 14 | [St0#leex.xfile]), 15 | {ok,Line3,REAs,Actions,St3} = 16 | parse_rules(Xfile, Line2, Macs, St2) 17 | catch 18 | exit:{badarg,R} -> 19 | foo(R), 20 | io:format(stdout, 21 | "ERROR reason ~p~n", 22 | R); 23 | error:R 24 | when R =:= 42 -> % when should be indented 25 | foo(R); 26 | error:R 27 | when % when should be indented 28 | R =:= 42 -> % but unsure about this (maybe 2 more) 29 | foo(R); 30 | error:R when 31 | R =:= foo -> % line should be 2 indented (works) 32 | foo(R); 33 | error:R -> 34 | foo(R), 35 | io:format(stdout, 36 | "ERROR reason ~p~n", 37 | R) 38 | after 39 | foo('after'), 40 | file:close(Xfile) 41 | end; 42 | try_catch() -> 43 | try 44 | foo(bar) 45 | of 46 | X when true andalso 47 | kalle -> 48 | io:format(stdout, "Parsing file ~s, ", 49 | [St0#leex.xfile]), 50 | {ok,Line3,REAs,Actions,St3} = 51 | parse_rules(Xfile, Line2, Macs, St2); 52 | X 53 | when false andalso 54 | bengt -> 55 | gurka(); 56 | X when 57 | false andalso % line should be 2 indented 58 | not bengt -> 59 | gurka(); 60 | X -> 61 | io:format(stdout, "Parsing file ~s, ", 62 | [St0#leex.xfile]), 63 | {ok,Line3,REAs,Actions,St3} = 64 | parse_rules(Xfile, Line2, Macs, St2) 65 | catch 66 | exit:{badarg,R} -> 67 | foo(R), 68 | io:format(stdout, 69 | "ERROR reason ~p~n", 70 | R); 71 | error:R -> 72 | foo(R), 73 | io:format(stdout, 74 | "ERROR reason ~p~n", 75 | R) 76 | after 77 | foo('after'), 78 | file:close(Xfile), 79 | bar(with_long_arg, 80 | with_second_arg) 81 | end; 82 | try_catch() -> 83 | try foo() 84 | after 85 | foo(), 86 | bar(with_long_arg, 87 | with_second_arg) 88 | end. 89 | 90 | indent_catch() -> 91 | D = B + 92 | float(43.1), 93 | 94 | B = catch oskar(X), 95 | 96 | A = catch (baz + 97 | bax), 98 | catch foo(), 99 | 100 | C = catch B + 101 | float(43.1), 102 | 103 | case catch foo(X) of 104 | A -> 105 | B 106 | end, 107 | 108 | case 109 | catch foo(X) 110 | of 111 | A -> 112 | B 113 | end, 114 | 115 | case 116 | foo(X) 117 | of 118 | A -> 119 | catch B, 120 | X 121 | end, 122 | 123 | try sune of 124 | _ -> foo 125 | catch _:_ -> baf 126 | end, 127 | 128 | Variable = try 129 | sune 130 | of 131 | _ -> 132 | X = 5, 133 | (catch foo(X)), 134 | X + 10 135 | catch _:_ -> baf 136 | after cleanup() 137 | end, 138 | 139 | try 140 | (catch sune) 141 | of 142 | _ -> 143 | foo1(), 144 | catch foo() %% Emacs bugs 145 | catch _:_ -> 146 | baf 147 | end, 148 | 149 | try 150 | (catch exit()) 151 | catch 152 | _ -> 153 | catch baf() 154 | end, 155 | ok. 156 | 157 | %% this used to result in 2x the correct indentation within the function 158 | %% body, due to the function name being mistaken for a keyword 159 | catcher(N) -> 160 | try generate_exception(N) of 161 | Val -> {N, normal, Val} 162 | catch throw:X -> {N, caught, thrown, X}; 163 | exit:X -> {N, caught, exited, X}; 164 | error:X -> {N, caught, error, X} 165 | end. 166 | 167 | unary_ops() -> 168 | case catch 169 | func() of 170 | asd -> 171 | ok 172 | end. 173 | -------------------------------------------------------------------------------- /apps/sourcer/test/indent_data/type_specs: -------------------------------------------------------------------------------- 1 | %% -*- Mode: erlang; indent-tabs-mode: nil -*- 2 | %% Copyright Ericsson AB 2017. All Rights Reserved. 3 | 4 | %% Tests how types and specs are indented (also that the editor can parse them) 5 | %% May need improvements 6 | 7 | 8 | -type ann() :: Var :: integer(). 9 | -type ann2() :: 'return' 10 | | 'return_white_spaces' 11 | | 'return_comments' 12 | | 'text' | ann(). 13 | -type paren() :: 14 | (ann2()). 15 | 16 | -type t6() :: 17 | 1 | 2 | 3 | 18 | 'foo' 19 | | 'bar'. 20 | 21 | -type t8() :: {any(),none(),pid(),port(), 22 | reference(),float()}. 23 | 24 | -type t14() :: [erl_scan:foo() | 25 | %% Should be highlighted 26 | term() | 27 | boolean() | 28 | byte() | 29 | char() | 30 | non_neg_integer() | nonempty_list() | 31 | pos_integer() | 32 | neg_integer() | 33 | number() | 34 | list() | 35 | nonempty_improper_list() | nonempty_maybe_improper_list() | 36 | maybe_improper_list() | string() | iolist() | byte() | 37 | module() | 38 | mfa() | 39 | node() | 40 | timeout() | 41 | no_return() | 42 | %% Should not be highlighted 43 | nonempty_() | nonlist() | 44 | erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. 45 | 46 | -type t15() :: {binary(),<<>>,<<_:34>>,<<_:_*42>>, 47 | <<_:3,_:_*14>>,<<>>} | [<<>>|<<_:34>>|<<_:16>>| 48 | <<_:3,_:_*1472>>|<<_:19,_:_*14>>| <<_:34>>| 49 | <<_:34>>|<<_:34>>|<<_:34>>]. 50 | 51 | -type t18() :: 52 | fun(() -> 53 | t17() | t16() 54 | ). 55 | -type t19() :: 56 | fun((t18()) -> t16()) | 57 | fun((nonempty_maybe_improper_list('integer', any())| 58 | 1|2|3|a|b|<<_:3,_:_*14>>|integer()) 59 | -> 60 | nonempty_maybe_improper_list('integer', any())| % Emacs differ 61 | 1|2|3|a|b|<<_:3,_:_*14>>|integer()). % Emacs differ 62 | -type t20() :: [t19(), ...]. 63 | -type t25() :: #rec3{f123 :: [t24() | 64 | 1|2|3|4|a|b|c|d| 65 | nonempty_maybe_improper_list(integer, any())]}. 66 | -type t26() :: #rec4{ a :: integer() 67 | , b :: any() 68 | }. 69 | 70 | %% Spec 71 | 72 | -spec t1(FooBar :: t99()) -> t99(); 73 | (t2()) -> t2(); 74 | (t4()) -> t4() when is_subtype(t4(), t24); 75 | (t23()) -> t23() when is_subtype(t23(), atom()), 76 | is_subtype(t23(), t14()); 77 | (t24()) -> t24() when is_subtype(t24(), atom()), 78 | is_subtype(t24(), t14()), 79 | is_subtype(t24(), t4()). 80 | 81 | -spec over_spec(I :: integer()) -> 82 | R1 :: foo:typen(); 83 | (A :: atom()) -> 84 | R2 :: foo:atomen(); 85 | (T :: tuple()) -> 86 | R3 :: bar:typen(). 87 | 88 | -spec mod:t2() -> any(). 89 | 90 | -spec handle_cast(Cast :: {'exchange', node(), [[name(),...]]} 91 | | {'del_member', name(), pid()}, 92 | #state{}) -> {'noreply', #state{}}. 93 | 94 | -spec handle_cast(Cast :: 95 | {'exchange', node(), [[name(),...]]} 96 | | {'del_member', name(), pid()}, 97 | #state{}) -> 98 | {'noreply', #state{}}. 99 | 100 | -spec all( 101 | fun((T) -> boolean()), List :: [T]) -> 102 | boolean() when is_subtype(T, term()). % (*) % Emacs differ 103 | 104 | -spec get_closest_pid(term()) -> 105 | Return :: pid() 106 | | {'error', {'no_process', term()}} 107 | | {'no_such_group', term()}. 108 | 109 | -spec add( X :: integer() 110 | , Y :: integer() 111 | ) -> integer(). 112 | 113 | -opaque attributes_data() :: 114 | [{'column', column()} | {'line', info_line()} | 115 | {'text', string()}] | {line(),column()}. 116 | 117 | 118 | -callback handle_call(Request :: term(), 119 | From :: {pid(), 120 | Tag :: term()}, 121 | State :: term()) -> 122 | {reply, Reply :: term(), NewState :: term()} | 123 | {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | 124 | {noreply, NewState :: term()} | 125 | {noreply, NewState :: term(), timeout() | hibernate} | 126 | {stop, Reason :: term(), Reply :: term(), NewState :: term()} | 127 | {stop, Reason :: term(), NewState :: term()}. 128 | 129 | -spec load(AppDescr, Distributed) -> 130 | 'ok' | {'error', Reason} when 131 | AppDescr :: Application | (AppSpec :: application_spec()), 132 | Application :: atom(), 133 | Distributed :: {Application,Nodes} 134 | | {Application,Time,Nodes} 135 | | 'default', 136 | Nodes :: [node() | tuple_of(node())], 137 | Time :: pos_integer(), 138 | Reason :: term(). 139 | 140 | -spec sparse_push_tuple_pairs(non_neg_integer(), array_indx(), 141 | _, _, indx_pairs(Type)) -> indx_pairs(Type). 142 | 143 | -type f() :: {module(), atom(), list()} 144 | | nonempty_maybe_improper_list(fun(), list()) 145 | | fun(). 146 | 147 | -spec logfile(Request :: {open, Filename}) -> 148 | ok | {error, OpenReason} when 149 | Filename ::file:name(), 150 | OpenReason :: allready_have_logfile | open_error(); 151 | (Request :: close) -> 152 | ok | {error, CloseReason} 153 | when 154 | CloseReason :: module_not_found 155 | ; (Request :: filename) -> 156 | Filename | {error, FilenameReason} when 157 | Filename :: file:name(), 158 | FilenameReason :: no_log_file. 159 | 160 | %% Old style 161 | 162 | -spec(exprs(Expressions, Bindings, LocalFunctionHandler) -> 163 | {value, Value, NewBindings} when 164 | Expressions :: expressions(), 165 | Bindings :: binding_struct(), 166 | LocalFunctionHandler :: local_function_handler(), 167 | Value :: value(), 168 | NewBindings :: binding_struct()). 169 | -------------------------------------------------------------------------------- /apps/sourcer/test/operations_data/aaa.erl: -------------------------------------------------------------------------------- 1 | -module(aaa). 2 | -include("aaa.hrl"). 3 | 4 | foo() -> 5 | bbb:bar(). 6 | 7 | %% extra 8 | baz() -> 9 | ?MMM, 10 | ok. 11 | 12 | mmm() -> 13 | ok. 14 | -------------------------------------------------------------------------------- /apps/sourcer/test/operations_data/aaa.hrl: -------------------------------------------------------------------------------- 1 | -define(MMM, aaa:mmm()). 2 | -------------------------------------------------------------------------------- /apps/sourcer/test/operations_data/bbb.erl: -------------------------------------------------------------------------------- 1 | -module(bbb). 2 | -include("aaa.hrl"). 3 | 4 | bar() -> 5 | ?MMM, 6 | aaa:baz(). 7 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_analyse_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_analyse_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | -define(DEBUG, true). 6 | -include("debug.hrl"). 7 | 8 | -include("sourcer_model.hrl"). 9 | 10 | merge_test_() -> 11 | M =#model{defs=[{def,[a1],1,0},{def,[b1],1,0}], 12 | refs=[{ref,[c1],1},{ref,[d1],1}]}, 13 | [ 14 | ?_assertEqual( 15 | M, 16 | sourcer_analyse:merge([ 17 | M 18 | ]) 19 | ), 20 | ?_assertEqual( 21 | M, 22 | sourcer_analyse:merge([ 23 | #model{}, 24 | M 25 | ]) 26 | ), 27 | ?_assertEqual( 28 | M, 29 | sourcer_analyse:merge([ 30 | M, 31 | #model{} 32 | ]) 33 | ), 34 | ?_assertEqual( 35 | #model{defs=[ 36 | {def,[a1],1,#{}}, 37 | {def,[a2],1,#{}}, 38 | {def,[b1],1,#{}}, 39 | {def,[b2],1,#{}} 40 | ], 41 | refs=[ 42 | {ref,[c1],1}, 43 | {ref,[c2],1}, 44 | {ref,[d1],1}, 45 | {ref,[d2],1} 46 | ]}, 47 | sourcer_analyse:merge([ 48 | #model{defs=[ 49 | {def,[a1],1,#{}}, 50 | {def,[b1],1,#{}} 51 | ], 52 | refs=[ 53 | {ref,[c1],1}, 54 | {ref,[d1],1} 55 | ]}, 56 | #model{defs=[ 57 | {def,[a2],1,#{}}, 58 | {def,[b2],1,#{}} 59 | ], 60 | refs=[ 61 | {ref,[c2],1}, 62 | {ref,[d2],1} 63 | ]}]) 64 | ), 65 | ?_assertEqual( 66 | #model{defs=[ 67 | {def,[{a1}],1,#{}}, 68 | {def,[{macro,1,1}],1,#{}}, 69 | {def,[{macro,1,1}],2,#{}} 70 | ], 71 | refs=[ 72 | {ref,[c1],1}, 73 | {ref,[c1],2}, 74 | {ref,[d1],1}, 75 | {ref,[d2],1} 76 | ]}, 77 | sourcer_analyse:merge([ 78 | #model{defs=[ 79 | {def,[{a1}],2,#{}}, 80 | {def,[{macro,1,1}], 2,#{}} 81 | ], 82 | refs=[ 83 | {ref,[c1],2}, 84 | {ref,[d1], 1} 85 | ]}, 86 | #model{defs=[ 87 | {def,[{a1}],1,#{}}, 88 | {def,[{macro,1,1}],1,#{}} 89 | ], 90 | refs=[ 91 | {ref,[c1],1}, 92 | {ref,[d2],1} 93 | ]}]) 94 | ), 95 | ?_assertEqual( 96 | #model{}, 97 | sourcer_analyse:merge([#model{}, #model{}]) 98 | ) 99 | ]. 100 | 101 | assert(Exp, Val) -> 102 | Expected = model(Exp), 103 | Value = sourcer_analyse:analyse_text(Val), 104 | {Val, ?_assertEqual(Expected, Value)}. 105 | 106 | analyze_test_() -> 107 | {ok, Terms} = file:consult("apps/sourcer/test/parser_model_tests_data"), 108 | [assert(Y, X) || {X,_,Y}<-lists:reverse(Terms)]. 109 | 110 | scan(D) -> 111 | {ok, Ts, _} = sourcer_scan:string(D), 112 | sourcer_scan:filter_ws_tokens(Ts). 113 | 114 | scan(D, P0) -> 115 | {ok, Ts, _} = sourcer_scan:string(D, P0), 116 | sourcer_scan:filter_ws_tokens(Ts). 117 | 118 | model({D, R}) -> 119 | #model{refs=lists:sort(R), defs=lists:sort(D)}. 120 | 121 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_db_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_db_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | text() -> 6 | " 7 | -module(foo). 8 | bar() -> 9 | quz(1). 10 | quz(1) -> 11 | ok; 12 | quz(_) -> 13 | ok. 14 | ". 15 | 16 | parse_file_test_1() -> 17 | Text = text(), 18 | {ok, AST, Refs, Lines} = sourcer_db:parse_file("foo1", Text), 19 | Chunks = chunk(Text, Lines, []), 20 | TextLines = sourcer_scan_util:split(Text), 21 | [ 22 | ?_assertMatch([ 23 | {attribute, 24 | {{1,1,1},13}, 25 | module,foo,"foo",undefined}, 26 | {function, 27 | {{2,3,15},20}, 28 | bar,0,[],[],[], 29 | {{2,15},3}, 30 | false}, 31 | {function, 32 | {{4,5,36},17}, 33 | quz,1,[],undefined, 34 | [ 35 | {clause, 36 | {{4,5,36},17},quz,[<<"1">>],<<"(1)">>,{{4,36},3}}, 37 | {clause, 38 | {{6,7,54},17},quz,[<<"_">>],<<"(_)">>,{{6,54},3}} 39 | ], 40 | {{4,36},3}, 41 | false} 42 | ], 43 | AST), 44 | ?_assertMatch([ 45 | {ref,{module_def,"foo"},1,13,module,-3,[],false}, 46 | {ref,{local_call,quz,1},28,3,bar,0,[],false}, 47 | {ref,{function_def,bar,0},15,3,bar,0,[],false}, 48 | {ref,{var_def,'_'},58,1,quz,1,"(_)",true}, 49 | {ref,{function_def,quz,1},36,3,quz,1,[],false} 50 | ], Refs), 51 | ?_assertMatch([{0,1,0},{1,14,1},{15,9,2},{24,12,3}, 52 | {36,10,4},{46,8,5},{54,10,6},{64,8,7},{72,4,8} 53 | ], Lines), 54 | ?_assertEqual(TextLines, Chunks) 55 | ]. 56 | 57 | get_element_test_000() -> 58 | Text = text(), 59 | {ok, AST, Refs, Lines} = sourcer_db:parse_file("foo1", Text), 60 | Open = [{<<"foo">>, Text, {AST, Refs, Lines}}], 61 | [ 62 | ?_assertMatch([], 63 | sourcer_model:get_element_at_pos(Open, <<"foo">>, #{line=>0, character=>0}) 64 | ), 65 | ?_assertMatch({ref,{module_def,"foo"},1,13,module,-3,[],false}, 66 | sourcer_model:get_element_at_pos(Open, <<"foo">>, #{line=>1, character=>1}) 67 | ), 68 | ?_assertMatch({ref,{function_def,bar,0},15,3,bar,0,[],false}, 69 | sourcer_model:get_element_at_pos(Open, <<"foo">>, #{line=>2, character=>1}) 70 | ), 71 | ?_assertMatch({ref,{function_def,quz,1},36,3,quz,1,[],false}, 72 | sourcer_model:get_element_at_pos(Open, <<"foo">>, #{line=>5, character=>1}) 73 | ) 74 | ]. 75 | 76 | chunk(_, [], R) -> 77 | lists:reverse(R); 78 | chunk(Text, [{Ofs, Len, _}|Lines], R) -> 79 | Text0 = string:slice(Text, Ofs, Len), 80 | chunk(Text, Lines, [Text0|R]). 81 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_indent_tests.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% 3 | -module(sourcer_indent_tests). 4 | -export([sourcer/1]). 5 | -include_lib("eunit/include/eunit.hrl"). 6 | 7 | default_indent_prefs_test_() -> 8 | 9 | IndentW2 = 2, 10 | PrefC = [{indentW, IndentW2}, 11 | {'when', 6} 12 | ], 13 | [?_assertMatch(#{indentW := 4, %% indentW 14 | after_op := 4, %% indentW 15 | 'when' := 6, %% IndentW + IndentW div 2 16 | 'after_when' := 10}, %% IndentW * 2 + IndentW div 2 17 | sourcer_indent:get_prefs([])), 18 | ?_assertMatch(#{indentW := 2, %% indentW 19 | after_op := 2, %% indentW 20 | 'when' := 6, %% overriden 21 | 'after_when' := 5}, %% IndentW * 2 + IndentW div 2 22 | sourcer_indent:get_prefs(PrefC))]. 23 | 24 | all_test_() -> 25 | Dir = filename:dirname(code:which(?MODULE)) ++ "/indent_data", 26 | OrigFs = filelib:wildcard(Dir ++ "/*"), 27 | io:format("Dir: ~s~nFs: ~p~n", [Dir, OrigFs]), 28 | Fs = [{File, unindent(File)} || File <- OrigFs, 29 | filename:extension(File) =:= ""], 30 | Indent = fun sourcer/1, 31 | [Indent(File) || {_, File} <- Fs], 32 | Res = [diff(Orig, File, 1) || {Orig, File} <- Fs], 33 | %% And do the indentation again to see that nothing have changed 34 | [Indent(File) || {_, File} <- Fs], 35 | Res2 = [diff(Orig, File, 2) || {Orig, File} <- Fs], 36 | {setup, 37 | fun()-> ok end, 38 | fun(_)-> %% Keep failed files to ease debugging 39 | [file:delete(File) || {ok, File} <- Res], 40 | ok 41 | end, 42 | [?_assertMatch({ok, _}, Result) || Result <- Res] ++ 43 | [?_assertMatch({ok, _}, Result) || Result <- Res2] 44 | }. 45 | 46 | lines_test_() -> 47 | Basic = 48 | "foo() -> 49 | line1, 50 | line2, 51 | case X of 52 | clause1 -> 53 | ok 54 | end, 55 | line7, 56 | ok.", 57 | Line2 = {2," line2,\n"," line2,\n"}, 58 | Line4 = {4," clause1 ->\n"," clause1 ->\n"}, 59 | Line6 = {6," end,\n", " end,\n"}, 60 | Line7 = {7," line7,\n", " line7,\n"}, 61 | [ ?_assertMatch([], sourcer_indent:lines(0, 0, Basic)) 62 | , ?_assertMatch([Line2], sourcer_indent:lines(2, 2, Basic)) 63 | , ?_assertMatch([Line2], sourcer_indent:lines(0, 3, Basic)) 64 | , ?_assertMatch([Line4], sourcer_indent:lines(4, 5, Basic)) 65 | , ?_assertMatch([Line6,Line7], sourcer_indent:lines(6, 7, Basic)) 66 | ]. 67 | 68 | line_test_() -> 69 | Str = ["%% Comments\n", % line 0 70 | "\n", 71 | "%%\n", 72 | "\n", 73 | "line_test(Arg1,\n", % line 4 74 | " Arg2,\n", 75 | " \n", 76 | " Arg4)\n", % line 7 77 | " \n", 78 | " when Arg1 =:= Arg2,\n", 79 | " \n", 80 | " Arg4 > 10 ->\n", % line 11 81 | " line1,\n", 82 | " case Arg1 of\n", 83 | " true ->\n", 84 | " case Arg2 of\n", % line 15 85 | " true ->\n", 86 | " ok\n", 87 | " \n", 88 | " end;\n", 89 | " \n", % line 20 90 | " false ->\n", 91 | " ok\n", 92 | " end,\n", 93 | " \n", 94 | " ok.\n" 95 | ], 96 | [?_test(do_test_line(N, Str)) || N <- lists:seq(0, length(Str)-1)]. 97 | 98 | do_test_line(N, Str) -> 99 | SrcLists = lists:sublist(Str, N), 100 | Src = unicode:characters_to_list([SrcLists,"\n"]), 101 | Indented = sourcer_indent:line(N, Src), 102 | Next = lists:nth(N+1, Str), 103 | %% io:format(user, "~.3w: ~s~n", [N, Next]), 104 | ?assertEqual({N,string:span(Next, " ")}, {N,string:span(Indented, " ")}). 105 | 106 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 107 | %% Helpers 108 | 109 | unindent(Input) -> 110 | Output = Input ++ ".actual", 111 | {ok, Bin} = file:read_file(Input), 112 | Lines0 = string:split(Bin, "\n", all), 113 | %% We leave one space, so we can show errors that should indent to col 0 114 | AddOne = fun(<<>>) -> <<>>; 115 | (<<"row", _/binary>>=Row) -> Row; 116 | (Str) -> [$\s|Str] 117 | end, 118 | Lines = [AddOne(string:trim(Line, leading, [$\s,$\t])) || Line <- Lines0], 119 | %% io:format("File: ~s lines: ~w~n", [Input, length(Lines0)]), 120 | %% [io:format("~s~n", [L]) || L <- Lines], 121 | ok = file:write_file(Output, lists:join("\n", Lines)), 122 | Output. 123 | 124 | diff(Orig, File, Pass) -> 125 | case os:cmd(["diff ", Orig, " ", File]) of 126 | "" -> {ok, File}; 127 | Diff -> 128 | io:format(user, "Fail: ~s vs ~s~n~s~n~n",[Orig, File, Diff]), 129 | {{fail, Pass}, File} 130 | end. 131 | 132 | sourcer(File) -> 133 | io:format("* Indenting: ~s *~n",[File]), 134 | {ok, Bin} = file:read_file(File), 135 | Src = unicode:characters_to_list(Bin), 136 | Indented = sourcer_indent:all(Src), 137 | file:write_file(File, unicode:characters_to_binary(Indented)). 138 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_model_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_model_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | -define(DEBUG, true). 6 | -include("debug.hrl"). 7 | 8 | -include("sourcer_model.hrl"). 9 | 10 | persistence_test_() -> 11 | F = case os:type() of 12 | {win32,_} -> "tmp/f"; 13 | _ -> "/tmp/f" 14 | end, 15 | [ 16 | {foreach, 17 | fun() -> file:delete(F), ok end, 18 | fun(_) -> file:delete(F), ok end, 19 | [ 20 | % TODO persist(F, "-module(mmm). -ifdef(X). foo()->ok. "), 21 | persist(F, "") 22 | ] 23 | } 24 | ]. 25 | 26 | get_elements_at_pos_test_() -> 27 | Text = " 28 | -module(foo). 29 | bar() -> 30 | quz(1). 31 | quz(1) -> 32 | ok; 33 | quz(_) -> 34 | ok. 35 | ", 36 | Model = sourcer_analyse:analyse_text(Text), 37 | [ 38 | ?_assertMatch({[{def,[{module,foo},{function,bar,0}], 39 | {{2,1},{2,4}}, 40 | #{}}], 41 | []}, 42 | sourcer_model:get_elements_at_pos(Model, {3, 4}) 43 | ), 44 | ?_assertMatch({[{def,[{module,foo},{function,bar,0}], 45 | {{2,1},{2,4}}, 46 | #{}}], 47 | [{ref,[{module,foo},{function,quz,1}],{{3,5},{3,8}}}]}, 48 | sourcer_model:get_elements_at_pos(Model, {3, 5}) 49 | ), 50 | ?_assertMatch({[{def,[{module,foo},{function,bar,0}], 51 | {{2,1},{2,4}}, 52 | #{}}], 53 | [{ref,[{module,foo},{function,quz,1}],{{3,5},{3,8}}}]}, 54 | sourcer_model:get_elements_at_pos(Model, {3, 6}) 55 | ), 56 | ?_assertMatch({[{def,[{module,foo},{function,bar,0}], 57 | {{2,1},{2,4}}, 58 | #{}}], 59 | []}, 60 | sourcer_model:get_elements_at_pos(Model, {3, 8}) 61 | ), 62 | ?_assertMatch({[{def,[{module,foo},{function,bar,0}], 63 | {{2,1},{2,4}}, 64 | #{}}], 65 | []}, 66 | sourcer_model:get_elements_at_pos(Model, {3, 9}) 67 | ) 68 | ]. 69 | 70 | persist(F, S) -> 71 | {ok, Ts, _} = sourcer_scan:string(S), 72 | Fs = sourcer_parse:parse(sourcer_scan:filter_ws_tokens(Ts)), 73 | E = sourcer_model:save_model(F, Fs), 74 | A = sourcer_model:load_model(F), 75 | ?_assertEqual(E, A). 76 | 77 | assert(Exp, Val) -> 78 | Expected = model(Exp), 79 | Value = sourcer_analyse:analyse_text(Val), 80 | {Val, ?_assertEqual(Expected, Value)}. 81 | 82 | scan(D) -> 83 | {ok, Ts, _} = sourcer_scan:string(D), 84 | sourcer_scan:filter_ws_tokens(Ts). 85 | 86 | scan(D, P0) -> 87 | {ok, Ts, _} = sourcer_scan:string(D, P0), 88 | sourcer_scan:filter_ws_tokens(Ts). 89 | 90 | model({D, R}) -> 91 | #model{refs=lists:sort(R), defs=lists:sort(D)}. 92 | 93 | print_key_test_() -> 94 | [ 95 | ?_assertEqual(<<"hej:">>, sourcer_model:print_key({module, hej})), 96 | ?_assertEqual(<<"\"hej\"">>, sourcer_model:print_key({include, "hej"})), 97 | ?_assertEqual(<<"\"hej\"">>, sourcer_model:print_key({include_lib, "hej"})), 98 | ?_assertEqual(<<"hej/3">>, sourcer_model:print_key({function, hej, 3})), 99 | ?_assertEqual(<<"@2">>, sourcer_model:print_key({clause, 2})), 100 | ?_assertEqual(<<"hej">>, sourcer_model:print_key({var, 'hej'})), 101 | ?_assertEqual(<<"'Hej'">>, sourcer_model:print_key({var, 'Hej'})), 102 | ?_assertEqual(<<"#hej">>, sourcer_model:print_key({record, hej})), 103 | ?_assertEqual(<<".hej">>, sourcer_model:print_key({field, hej})), 104 | ?_assertEqual(<<"?hej/2">>, sourcer_model:print_key({macro, hej, 2})), 105 | ?_assertEqual(<<"?hej">>, sourcer_model:print_key({macro, hej, -1})), 106 | ?_assertEqual(<<"?Hej/0">>, sourcer_model:print_key({macro, 'Hej', 0})), 107 | ?_assertEqual(<<"was()/3">>, sourcer_model:print_key({type, was, 3})), 108 | ?_assertEqual(<<"hej:ff/2">>, sourcer_model:print_key([{module, hej},{function, ff, 2}])), 109 | ?_assertEqual(<<"hej:">>, sourcer_model:print_key([{module, hej}])), 110 | ?_assertEqual(<<"{asdd,hej}">>, sourcer_model:print_key([{asdd, hej}])), 111 | ?_assertEqual(<<"">>, sourcer_model:print_key([])) 112 | ]. 113 | 114 | 115 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_operations_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_operations_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | -define(DEBUG, true). 6 | -include("debug.hrl"). 7 | 8 | -include("sourcer_model.hrl"). 9 | 10 | general_test_() -> 11 | DB = load_db(), 12 | [ 13 | ?_assertEqual(3, dict:size(DB#db.models)) 14 | ]. 15 | 16 | symbols_test_() -> 17 | DB = load_db(), 18 | [ 19 | ?_assertEqual([], 20 | sourcer_operations:symbols(<<"">>, DB)), 21 | 22 | %% TODO how to get the real file URI? 23 | ?_assertMatch([ 24 | {_, 25 | {def,[{module,aaa},{function,mmm,0}], 26 | {{11,1},{11,4}}, 27 | #{body := {{11,1},{12,7}}}} 28 | } 29 | ], 30 | sourcer_operations:symbols(<<"mm">>, DB)) 31 | ]. 32 | 33 | document_symbols_test_() -> 34 | DB = load_db(), 35 | [ 36 | ?_assertEqual([ 37 | [{module,aaa}], 38 | [{module,aaa},{function,baz,0}], 39 | [{module,aaa},{function,foo,0}], 40 | [{module,aaa},{function,mmm,0}] 41 | ], 42 | dkeys(sourcer_operations:document_symbols(data_file("aaa.erl"), DB)) 43 | ) 44 | ]. 45 | 46 | hover_test_() -> 47 | DB = load_db(), 48 | [ 49 | ?_assertEqual(<<"">>, 50 | unicode:characters_to_binary(sourcer_operations:hover(data_file("aaa.erl"), {2, 3}, DB))), 51 | ?_assertEqual(<<"### aaa:foo/0\n\n\n\n```\n\n```\n\n\n\n">>, 52 | unicode:characters_to_binary(sourcer_operations:hover(data_file("aaa.erl"), {3, 2}, DB))), 53 | ?_assertEqual(<<"### aaa:baz/0\n\n\n\n```\n\n```\n\n\n%% extra\n\n">>, 54 | unicode:characters_to_binary(sourcer_operations:hover(data_file("aaa.erl"), {7, 2}, DB))) 55 | ]. 56 | 57 | definition_test_() -> 58 | DB = load_db(), 59 | [ 60 | ?_assertEqual([], sourcer_operations:definition(data_file("aaa.erl"), {2, 1}, DB)), 61 | ?_assertMatch([ 62 | { 63 | _, 64 | {def,[{module,bbb},{function,bar,0}], 65 | {{3,1},{3,4}}, 66 | #{body := {{3,1},{5,14}}}} 67 | }], 68 | sourcer_operations:definition(data_file("aaa.erl"), {4, 10}, DB)) 69 | ]. 70 | 71 | references_test_() -> 72 | DB = load_db(), 73 | [ 74 | ?_assertEqual([], sourcer_operations:references(data_file("aaa.erl"), 75 | {2, 1}, #{}, DB)), 76 | ?_assertMatch([ 77 | { 78 | _, 79 | {ref,[{module,bbb},{function,bar,0}],{{4,9},{4,12}}} 80 | }], 81 | sourcer_operations:references(data_file("aaa.erl"), 82 | {4, 10}, #{includeDeclaration=>false}, DB)), 83 | ?_assertMatch([ 84 | { 85 | _, 86 | {def,[{module,bbb},{function,bar,0}], 87 | {{3,1},{3,4}}, 88 | #{body := {{3,1},{5,14}}}} 89 | }, 90 | { 91 | _, {ref,[{module,bbb},{function,bar,0}],{{4,9},{4,12}}} 92 | }], 93 | sourcer_operations:references(data_file("aaa.erl"), 94 | {4, 10}, #{includeDeclaration=>true}, DB)) 95 | ]. 96 | 97 | completion_test_() -> 98 | DB = load_db(), 99 | [ 100 | ]. 101 | 102 | highlight_test_() -> 103 | DB = load_db(), 104 | [ 105 | ?_assertEqual([], 106 | sourcer_operations:highlight(data_file("aaa.erl"), 107 | {2, 1}, DB)), 108 | ?_assertEqual([ 109 | {ref,[{module,bbb},{function,bar,0}],{{4,9},{4,12}}}, 110 | {def,[{module,bbb},{function,bar,0}], 111 | {{3,1},{3,4}}, 112 | #{body => {{3,1},{5,14}}}} 113 | ], 114 | sourcer_operations:highlight(data_file("aaa.erl"), 115 | {4, 10}, DB)) 116 | ]. 117 | 118 | load_db() -> 119 | Dir = data_dir(), 120 | Files0 = filelib:wildcard(Dir ++ "/*"), 121 | Files = [sourcer_util:path_to_uri(F) || F<-Files0], 122 | DB = sourcer_db:new(), 123 | sourcer_db:add_files(Files, DB). 124 | 125 | data_dir() -> 126 | filename:dirname(code:which(?MODULE)) ++ "/operations_data". 127 | 128 | data_file(Name) -> 129 | sourcer_util:path_to_uri(filename:join(data_dir(), Name)). 130 | 131 | dkeys(Defs) -> 132 | [X || #def{ctx=X} <- Defs]. 133 | 134 | rkeys(Defs) -> 135 | [X || #ref{ctx=X} <- Defs]. -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_parse_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_parse_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | -include("sourcer_parse.hrl"). 6 | -include("sourcer_model.hrl"). 7 | 8 | -define(DEBUG, true). 9 | -include("debug.hrl"). 10 | 11 | -define(e(R, S), 12 | ?_assertEqual(R, sourcer_parse:parse(scan(S))) 13 | ). 14 | 15 | assert(Exp, Val) -> 16 | Expected = Exp, 17 | Value = sourcer_parse:parse(scan(Val)), 18 | {Val, ?_assertEqual(Expected, Value)}. 19 | 20 | parse_test_() -> 21 | {ok, Terms} = file:consult("apps/sourcer/test/parser_model_tests_data"), 22 | [assert(Y, X) || {X,Y,_}<-lists:reverse(Terms)]. 23 | 24 | scan(D) -> 25 | {ok, Ts, _} = sourcer_scan:string(D), 26 | sourcer_scan:filter_ws_tokens(Ts). 27 | 28 | scan(D, P0) -> 29 | {ok, Ts, _} = sourcer_scan:string(D, P0), 30 | sourcer_scan:filter_ws_tokens(Ts). 31 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_parse_util_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_parse_util_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | -define(SUT, sourcer_parse_util). 6 | 7 | extract_top_comments_test_() -> 8 | [ 9 | ?_assertMatch({none, 10 | [{atom,_,"hello",hello}]}, 11 | ?SUT:extract_top_comments(scan_ws("\nhello"))), 12 | ?_assertMatch({{{0,1},{2,8}}, 13 | [{atom,_,"hello",hello}]}, 14 | ?SUT:extract_top_comments(scan_ws("%a\n%bc\n %%cde\nhello"))), 15 | ?_assertMatch({{{0,1},{0,6}}, 16 | [{atom,_,"hello",hello}]}, 17 | ?SUT:extract_top_comments(scan_ws("%afgg\n \n\nhello"))), 18 | ?_assertMatch({{{4,1},{4,7}}, 19 | [{atom,_,"hello",hello}]}, 20 | ?SUT:extract_top_comments(scan_ws("%12345\n%123\n\n\n%%1234\nhello"))) 21 | ]. 22 | 23 | take_until_token_test_() -> 24 | [ 25 | ?_assertEqual({scan("a"), none, []}, 26 | ?SUT:take_until_token(scan("a"), dot)), 27 | ?_assertEqual({scan("a"), {dot,{0,2},".",undefined}, scan(" b")}, 28 | ?SUT:take_until_token(scan("a. b"), dot)), 29 | ?_assertEqual({scan("a"), {dot,{0,2},".",undefined}, scan(" b.")}, 30 | ?SUT:take_until_token(scan("a. b."), dot)), 31 | ?_assertEqual({scan("fun a,b end"), {',',{0,12},",",undefined}, scan(" b")}, 32 | ?SUT:take_until_token(scan("fun a,b end, b"), ',')), 33 | ?_assertEqual({scan("fun a/2"), {',',{0,8},",",undefined}, scan(" b")}, 34 | ?SUT:take_until_token(scan("fun a/2, b"), ',')), 35 | ?_assertEqual({scan("fun((1,2)->X)"), {',',{0,14},",",undefined}, scan(" b")}, 36 | ?SUT:take_until_token(scan("fun((1,2)->X), b"), ',')), 37 | ?_assertEqual({[], {dot,{0,1},".",undefined}, scan(" a")}, 38 | ?SUT:take_until_token(scan(". a"), dot)), 39 | ?_assertEqual({[], none, []}, 40 | ?SUT:take_until_token([], dot)) 41 | ]. 42 | 43 | take_until_matching_token_test_() -> 44 | [ 45 | ?_assertMatch({{'(',_,_,_},[],none,[]}, 46 | ?SUT:take_until_matching_token({'(', 1,2,3}, [])), 47 | ?_assertMatch({{'(',_,_,_},[{atom,_,_,a},{',',_,_,_},{atom,_,_,b}], none, []}, 48 | ?SUT:take_until_matching_token({'(', 1,2,3}, scan("a,b"))), 49 | ?_assertMatch({{'(',_,_,_},[{atom,_,_,a},{',',_,_,_},{'(',_,_,_},{atom,_,_,b}], none, []}, 50 | ?SUT:take_until_matching_token({'(', 1,2,3}, scan("a,(b"))), 51 | ?_assertMatch({{'(',_,_,_}, [{atom,_,_,a},{',',_,_,_},{atom,_,_,b}], {')',_,_,_}, []}, 52 | ?SUT:take_until_matching_token({'(', 1,2,3}, scan("a,b)"))), 53 | ?_assertMatch({{'if',_,_,_}, [], {'end',_,_,_}, []}, 54 | ?SUT:take_until_matching_token({'if', 1,2,3}, scan("end"))), 55 | ?_assertMatch({{'(',_,_,_},[{'[',_,_,_},{']',_,_,_}],{')',_,_,_}, [{atom,_,_,a}]}, 56 | ?SUT:take_until_matching_token({'(', 1,2,3}, scan("[])a"))), 57 | ?_assertMatch({{'(',_,_,_},[{'(',_,_,_},{')',_,_,_}],{')',_,_,_}, [{atom,_,_,a}]}, 58 | ?SUT:take_until_matching_token({'(', 1,2,3}, scan("())a"))), 59 | ?_assertMatch({{'(',_,_,_},[{'(',_,_,_},{atom,_,_,b},{',',_,_,_},{atom,_,_,c},{')',_,_,_}],{')',_,_,_}, [{atom,_,_,a},{',',_,_,_}]}, 60 | ?SUT:take_until_matching_token({'(', 1,2,3}, scan("(b,c))a,"))) 61 | ]. 62 | 63 | split_at_token_test_() -> 64 | [ 65 | ?_assertEqual([ 66 | {scan("a"),none} 67 | ], 68 | ?SUT:split_at_token(scan("a"), dot)), 69 | ?_assertEqual([ 70 | {scan("a"), {dot,{0,2},".",undefined}}, 71 | {scan(" b"), none} 72 | ], 73 | ?SUT:split_at_token(scan("a. b"), dot)), 74 | ?_assertEqual([ 75 | {scan("a"), {dot,{0,2},".",undefined}}, 76 | {[{atom,{1,1},"b",b}], {dot,{1,2},".",undefined}} 77 | ], 78 | ?SUT:split_at_token(scan("a.\nb."), dot)), 79 | ?_assertEqual([ 80 | {scan("a"), {dot,{0,2},".",undefined}}, 81 | {scan("b", {0,4}), {dot,{0,5},".",undefined}} 82 | ], 83 | ?SUT:split_at_token(scan("a. b."), dot)), 84 | ?_assertEqual([{[], {dot,{0,1},".",undefined}}, {scan(" a"), none}], 85 | ?SUT:split_at_token(scan(". a"), dot)), 86 | ?_assertEqual([{scan("a"), {',',{0,2},",",undefined}}, 87 | {scan(" {b,c}"), {',',{0,8},",",undefined}}, 88 | {scan(" d"), none} 89 | ], 90 | ?SUT:split_at_token(scan("a,{b,c},d"), ',')), 91 | ?_assertMatch([], 92 | ?SUT:split_at_token([], dot)) 93 | ]. 94 | 95 | middle_test_() -> 96 | [ 97 | ?_assertMatch([y,z], ?SUT:middle([x,y,z,w])), 98 | ?_assertMatch([y], ?SUT:middle([x,y,z])), 99 | ?_assertMatch([], ?SUT:middle([x,y])), 100 | ?_assertMatch([], ?SUT:middle([x])), 101 | ?_assertMatch([], ?SUT:middle([])) 102 | ]. 103 | 104 | take_block_list_test_() -> 105 | [ 106 | ?_assertEqual({[scan(" a")], scan(" b")}, 107 | ?SUT:take_block_list(scan("(a)b")) 108 | ), 109 | ?_assertEqual({[scan(" a")], scan(" b")}, 110 | ?SUT:take_block_list(scan("fun a end b")) 111 | ), 112 | ?_assertEqual({[scan(" (a)"),scan(" b")], scan(" c")}, 113 | ?SUT:take_block_list(scan("((a),b)c")) 114 | ) 115 | ]. 116 | 117 | scan(D) -> 118 | {ok, Ts, _} = sourcer_scan:string(D), 119 | sourcer_scan:filter_ws_tokens(Ts). 120 | 121 | scan_ws(D) -> 122 | {ok, Ts, _} = sourcer_scan:string(D), 123 | Ts. 124 | 125 | scan(D, P0) -> 126 | {ok, Ts, _} = sourcer_scan:string(D, P0), 127 | sourcer_scan:filter_ws_tokens(Ts). 128 | -------------------------------------------------------------------------------- /apps/sourcer/test/sourcer_util_tests.erl: -------------------------------------------------------------------------------- 1 | -module(sourcer_util_tests). 2 | 3 | -include_lib("eunit/include/eunit.hrl"). 4 | 5 | uri_test_() -> 6 | Data = [ 7 | {<<"file:///place/foo/bar.baz">>, "/place/foo/bar.baz"}, 8 | %{<<"file:///c%3A/path/to/file/d%C3%BCr%C3%BCm%20d%C3%B6ner.php">>, 9 | %"c:\\path\\to\\file\\dürüm döner.php" 10 | %}, 11 | {<<"file:///c%3A/path/to/file/dürüm%20döner.php"/utf8>>, 12 | "c:\\path\\to\\file\\dürüm döner.php" 13 | }, 14 | {<<"file:///c%3A/foo/bar.baz">>, "c:\\foo\\bar.baz"} 15 | ], 16 | [ 17 | [ 18 | ?_assertEqual(Path, sourcer_util:uri_to_path(Uri)), 19 | ?_assertEqual(Uri, sourcer_util:path_to_uri(Path)) 20 | ] 21 | || {Uri, Path} <- Data 22 | ]. 23 | 24 | uri_2_test_() -> 25 | Data = [ 26 | {<<"file:///c:/foo/bar.baz">>, "c:\\foo\\bar.baz"} 27 | ], 28 | [ 29 | [ 30 | ?_assertEqual(Path, sourcer_util:uri_to_path(Uri)) 31 | ] 32 | || {Uri, Path} <- Data 33 | ]. 34 | -------------------------------------------------------------------------------- /apps/sourcer/test2/sourcer_open_tests.erl: -------------------------------------------------------------------------------- 1 | %% coding: latin-1 2 | %% Author: jakob 3 | %% Created: 7 may 2013 4 | -module(sourcer_open_tests). 5 | 6 | -include_lib("eunit/include/eunit.hrl"). 7 | -include_lib("sourcer_open.hrl"). 8 | 9 | internal_split_test_() -> 10 | [ 11 | ?_assertEqual({"abcd",2}, split("ab&cd")), 12 | ?_assertEqual({"cd",0}, split("&cd")), 13 | ?_assertEqual({"ab",2}, split("ab&")), 14 | ?_assertEqual({"ab",-1}, split("ab")) 15 | ]. 16 | 17 | open_test_() -> 18 | [ 19 | ?_assertEqual({record, rec}, 20 | open_test("-r&ecord(rec, {aa, bb}).")), 21 | ?_assertEqual({local, foo, 1}, 22 | open_test("-module(a).\nf&oo(x)-> ok.")), 23 | ?_assertEqual({include, "foo"}, 24 | open_test("-includ&e(\"foo\").")), 25 | ?_assertEqual({include, "foo"}, 26 | open_test("-include(\"fo&o\").")), 27 | ?_assertEqual({include_lib,"file.hrl", 28 | code:lib_dir(stdlib)++"/file.hrl"}, 29 | open_test("-includ&e_lib(\"stdlib/file.hrl\").")), 30 | ?_assertEqual({external,a,b,0,not_found}, 31 | open_test("foo()-> a&:b().")), 32 | ?_assertEqual({macro, '?HELLO'}, 33 | open_test("foo()-> ?HEL&LO.")), 34 | ?_assertEqual({variable,'AA'}, 35 | open_test("foo()-> A&A.")), 36 | ?_assertEqual({variable, 'BB'}, 37 | open_test("-a() -> #r{field1=A, field2=B&B}.")), 38 | ?_assertEqual({local, aa, 0}, 39 | open_test("-type a&a()::integer().")) 40 | ]. 41 | 42 | open_record_field_test_() -> 43 | [ 44 | ?_assertEqual({field, rec, bb}, 45 | open_test("-a() -> #rec{aa, b&b}).")), 46 | ?_assertEqual({field, rec, aa}, 47 | open_test("-record(rec, {a&a, bb}).")), 48 | ?_assertEqual({field, rec, bb}, 49 | open_test("-record(rec, {aa, b&b}).")), 50 | ?_assertEqual({field, rec, aa}, 51 | open_test("-a() -> #rec{a&a, bb}).")), 52 | ?_assertEqual({field, r, field2}, 53 | open_test("-a() -> #r{field1=A, fiel&d2=B}.")), 54 | ?_assertEqual({field, r, field1}, 55 | open_test("-a() -> #r{fiel&d1=A, field2=B}.")) 56 | ]. 57 | 58 | open_test(S) -> 59 | {S1, Offset} = split(S), 60 | sourcer_scanner:create(test), 61 | sourcer_scanner:initial_scan(test, "", S1, ""), 62 | R = sourcer_open:open(test, Offset, #open_context{imports=[]}), 63 | sourcer_scanner:dispose(test), 64 | R. 65 | 66 | split(S) -> 67 | split(S, [], 0). 68 | 69 | split([], Acc, _N) -> 70 | {lists:reverse(Acc), -1}; 71 | split([$& | T], Acc, N) -> 72 | {lists:reverse(Acc,T), N}; 73 | split([H|T], Acc, N) -> 74 | split(T, [H|Acc], N+1). 75 | -------------------------------------------------------------------------------- /apps/sourcer/test2/sourcer_scan_model_tests.erl: -------------------------------------------------------------------------------- 1 | %% @author jakob 2 | 3 | -module(sourcer_scan_model_tests). 4 | 5 | -include_lib("eunit/include/eunit.hrl"). 6 | -include("sourcer_token.hrl"). 7 | 8 | %% 9 | %% API Functions 10 | %% 11 | 12 | scanner_test_() -> 13 | [?_assertEqual({[#token{kind = atom, line = 0, offset = 0,length = 1, value = a, text="a"}, 14 | #token{kind = '(', line = 0, offset = 1, length = 1, text="("}, 15 | #token{kind = ')', line = 0, offset = 2, length = 1, text=")"}, 16 | #token{kind = '->', line = 0, offset = 4, length = 2, text="->"}, 17 | #token{kind = atom, line = 0, offset = 7, length = 1, value = b, text="b"}, 18 | #token{kind = dot, line = 0, offset = 8, length = 1, text = "."}], 19 | [#token{kind = atom, line = 0, offset = 0,length = 4, value = test, text="test"}, 20 | #token{kind = '(', line = 0, offset = 4, length = 1, text="("}, 21 | #token{kind = ')', line = 0, offset = 5, length = 1, text=")"}, 22 | #token{kind = '->', line = 0, offset = 7, length = 2, text="->"}, 23 | #token{kind = atom, line = 0, offset = 10, length = 1, value = b, text="b"}, 24 | #token{kind = dot, line = 0, offset = 11, length = 1, text = "."}]}, 25 | test_replace("a() -> b.", 0, 1, "test")) 26 | ]. 27 | 28 | replace_at_eof_test_() -> 29 | [?_assertEqual({[#token{kind = atom, line = 0, offset = 0, length = 2, value = ab, text="ab"}], 30 | [#token{kind = atom, line = 0, offset = 0, length = 3, value = abc, text="abc"}]}, 31 | test_replace("ab", 2, 0, "c")) 32 | ]. 33 | 34 | replace_at_eol_test_() -> 35 | [?_assertEqual({[#token{kind = atom, line = 0, offset = 0, length = 1, value = a, text="a"}, 36 | #token{kind = atom, line = 1, offset = 2, length = 1, value = b, text="b"}], 37 | [#token{kind = atom, line = 0, offset = 0, length = 2, value = ac, text="ac"}, 38 | #token{kind = atom, line = 1, offset = 3, length = 1, value = b, text="b"}]}, 39 | test_replace("a\nb", 1, 0, "c")) 40 | ]. 41 | 42 | %% 43 | %% Local Functions 44 | %% 45 | 46 | test_replace(S, Pos, RemoveLength, NewText) -> 47 | M = sourcer_scan_model:do_scan(testing, S), 48 | NewM = sourcer_scan_model:replace_text(M, Pos, RemoveLength, NewText), 49 | R1 = sourcer_scan_model:get_all_tokens(M), 50 | R2 = sourcer_scan_model:get_all_tokens(NewM), 51 | {R1, R2}. 52 | -------------------------------------------------------------------------------- /apps/sourcer/test2/sourcer_search_tests.erl: -------------------------------------------------------------------------------- 1 | %% Author: jakob 2 | %% Created: 20 dec 2010 3 | -module(sourcer_search_tests). 4 | 5 | -include_lib("eunit/include/eunit.hrl"). 6 | 7 | %% 8 | %% Exported Functions 9 | %% 10 | 11 | -define(ARI_TYPESPEC, -2). 12 | -define(ARI_ATTRIBUTE, -3). 13 | -define(ARI_parse_record, -4). 14 | -define(ARI_MACRO_DEF, -5). 15 | -define(ARI_INCLUDE, -6). 16 | -define(ARI_RECORD_FIELD_DEF, -7). 17 | 18 | record_ref_within_type_spec_test_() -> 19 | S = "-record(a, {b, c :: #rec{}}).", 20 | Expected = [{"xxx", a, ?ARI_parse_record, [], false, 20, 4, false}], 21 | Value = test_refs(S, {record_ref, rec}), 22 | [?_assertEqual(Expected, Value)]. 23 | 24 | record_field_ref_test_() -> 25 | S = "f() -> #record{a=ok}, #record.a.", 26 | Expected = [{"xxx",f,0,[],false,30,1,false}, 27 | {"xxx", f, 0, [], false, 15, 1, false}], 28 | Value = test_refs(S, {record_field_ref, record, a}), 29 | [?_assertEqual(Expected, Value)]. 30 | 31 | external_call_after_record_dot_field_test_() -> 32 | S = "f() ->\n #a.b,\n a:f().\n", 33 | Expected = [{"xxx", f, 0, [], false, 21, 3, false}], 34 | Value = test_refs(S, {external_call, a, f, 0}), 35 | [?_assertEqual(Expected, Value)]. 36 | 37 | local_call_in_record_test_() -> 38 | S = "a() ->\n y(),\n A#b{x = y()}.\n", 39 | Expected = [{"xxx", a, 0, [], false, 11, 1, false}, 40 | {"xxx", a, 0, [], false, 28, 1, false}], 41 | Value = test_refs(S, {external_call, xxx, y, 0}), 42 | [?_assertEqual(Expected, Value)]. 43 | 44 | external_call_after_empty_record_test_() -> 45 | S = "f() ->\n #x{},\n a:f().\n", 46 | Expected1 = [{"xxx", f, 0, [], false, 21, 3, false}], 47 | Value1 = test_refs(S, {external_call, a, f, 0}), 48 | Expected2 = [{"xxx", f, 0, [], false, 11, 2, false}], 49 | Value2 = test_refs(S, {record_ref, x}), 50 | [?_assertEqual(Expected1, Value1), 51 | ?_assertEqual(Expected2, Value2)]. 52 | 53 | find_second_field_in_record_match_test_() -> 54 | %% http://www.assembla.com/spaces/sourcer/tickets/1268-searching---can-t-find-fields-in-record-match---construction 55 | S = "x(A, B) ->\n #r{field1=A, field2=B}.", 56 | Value = test_refs(S, {record_field_ref, r, field2}), 57 | Expected = [{"xxx",x,2,"(A, B)",false,28,6,false}], 58 | [?_assertEqual(Expected, Value)]. 59 | 60 | 61 | %% 62 | %% Local Functions 63 | %% 64 | 65 | test_refs(S, SearchPattern) -> 66 | {ok, Tokens, _EndPos} = sourcer_scan:string(S), 67 | {_Forms, _Comments, Refs} = sourcer_np:parse(Tokens), 68 | sourcer_search:find_data(Refs, [SearchPattern], xxx, "xxx"). 69 | -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | {require_otp_vsn, "20.*"}. 2 | 3 | {erl_opts, [ 4 | warn_deprecated_function, 5 | warn_export_all, 6 | warn_export_vars, 7 | warn_obsolete_guard, 8 | warn_shadow_vars, 9 | warn_unused_function, 10 | warn_unused_import, 11 | warn_unused_record, 12 | warn_unused_vars, 13 | 14 | nowarnings_as_errors 15 | %warnings_as_errors 16 | ]}. 17 | 18 | {xref_warnings, true}. 19 | {xref_checks, [ 20 | undefined_function_calls, 21 | undefined_functions, 22 | locals_not_used, 23 | % exports_not_used, 24 | deprecated_function_calls, 25 | deprecated_functions 26 | ]}. 27 | 28 | {dialyzer, [ 29 | %% Store PLT locally inside the project in .rebar (Default) 30 | %% {plt_location, local}, 31 | %% Store PLT in custom directory 32 | %% {plt_location, "custom_dir"}, 33 | {warnings, [unmatched_returns, error_handling, unknown]}, 34 | {base_plt_apps, [erts, kernel, stdlib, syntax_tools, tools, xmerl, inets]} 35 | ]}. 36 | 37 | {plugins, [coveralls]}. 38 | {cover_enabled , true}. 39 | {cover_export_enabled , true}. 40 | {cover_print_enable , true}. 41 | {coveralls_coverdata , "_build/test/cover/eunit.coverdata"}. 42 | {coveralls_service_name, "travis-ci"}. 43 | 44 | {escript_main_app, erlang_ls}. 45 | {escript_comment, "%% v0.3.0\n"}. 46 | {escript_emu_args, "%%! -noinput"}. % this is for open_port in jsonrpc.erl to work 47 | 48 | {provider_hooks, [{post, [{compile, escriptize}]}]}. -------------------------------------------------------------------------------- /rebar.config.script: -------------------------------------------------------------------------------- 1 | case os:getenv("TRAVIS") of 2 | "true" -> 3 | JobId = os:getenv("TRAVIS_JOB_ID"), 4 | lists:keystore(coveralls_service_job_id, 1, CONFIG, {coveralls_service_job_id, JobId}); 5 | _ -> 6 | CONFIG 7 | end. 8 | -------------------------------------------------------------------------------- /rebar.lock: -------------------------------------------------------------------------------- 1 | {"1.1.0", 2 | [{<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0}, 3 | {<<"jsx">>,{pkg,<<"jsx">>,<<"2.9.0">>},0}]}. 4 | [ 5 | {pkg_hash,[ 6 | {<<"getopt">>, <<"C73A9FA687B217F2FF79F68A3B637711BB1936E712B521D8CE466B29CBF7808A">>}, 7 | {<<"jsx">>, <<"D2F6E5F069C00266CAD52FB15D87C428579EA4D7D73A33669E12679E203329DD">>}]} 8 | ]. 9 | -------------------------------------------------------------------------------- /rebar3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/erlang/sourcer/27ea9c63998b9e694eb7b654dd05b831b989e69e/rebar3 -------------------------------------------------------------------------------- /sourcer.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | }, 6 | { 7 | "path": "../vscode-erlang-lsp" 8 | }, 9 | { 10 | "path": "/home/vlad/projects/rebar3" 11 | } 12 | ], 13 | "settings": { 14 | "erlang.runtime": "v20" 15 | } 16 | } --------------------------------------------------------------------------------