~technomancy/fennel

8866122acfaac272ce6cf6180c0fdd005b0edcc0 — Andrey Listopadov 2 months ago a230e2d
add ,apropos ,apropos-doc and ,apropos-show-docs repl commands

This patch adds three new commands: ,apropos ,apropos-doc and
,apropos-show-docs.  All commands accept a Lua pattern as an input.

,apropos will print all function names matching this pattern,
e.g. ,apropos table%. will list all functions from the table module

,aprops-doc works similarly, but instead of searching for the pattern
in function name, it searches the pattern in all documentations
available. E.g. ,apropos-doc "arity check" will list lambda and λ

,apropos-show-docs works similarly to ,apropos but displays all docs
matching a pattern in the function name.
3 files changed, 106 insertions(+), 1 deletions(-)

M changelog.md
M src/fennel/repl.fnl
M test/repl.fnl
M changelog.md => changelog.md +1 -0
@@ 4,6 4,7 @@ Changes are **marked in bold** which could result in backwards-incompatibility.

## 0.10.0 / ???

* Add `,apropos pattern` and `,apropos-doc pattern` repl commands
* Deprecate `pick-args` macro
* Support repl completion on methods inside tables
* Add separate `FENNEL_MACRO_PATH` environment variable for `fennel.macro-path`

M src/fennel/repl.fnl => src/fennel/repl.fnl +78 -0
@@ 174,6 174,84 @@ For more information about the language, see https://fennel-lang.org/reference")
(compiler.metadata:set commands.complete :fnl/docstring
                       "Print all possible completions for a given input.")

(fn apropos* [pattern module prefix seen names]
  ;; package.loaded can contain modules with dots in the names.  Such
  ;; names are renamed to contain / instead of a dot.
  (each [name module (pairs module)]
    (when (and (= :string (type name))
               (not= package module))
      (match (type module)
        :function (when (: (.. prefix name) :match pattern)
                    (table.insert names (.. prefix name)))
        :table (when (not (. seen module))
                 (apropos* pattern
                           module
                           (.. prefix (name:gsub "%." "/") ".")
                           (doto seen (tset module true))
                           names)))))
  names)

(fn apropos [pattern]
  ;; _G. part is stripped from patterns to provide more stable output.
  ;; The order we traverse package.loaded is arbitrary, so we may see
  ;; top level functions either as is or under the _G module.
  (let [names (apropos* pattern package.loaded "" {} [])]
    (icollect [_ name (ipairs names)]
      (name:gsub "^_G%." ""))))

(fn commands.apropos [env read on-values on-error scope]
  (match (pcall read)
    (true true input) (on-values (apropos (tostring input)))
    (_ _ ?msg) (on-error :Parse (or ?msg "Couldn't parse apropos input."))))

(compiler.metadata:set commands.apropos :fnl/docstring
                       "Print all functions matching a pattern in all loaded modules.")

(fn apropos-follow-path [path]
  ;; Follow path to the target based on apropos path format
  (let [paths (icollect [p (path:gmatch "[^%.]+")] p)]
    (var tgt package.loaded)
    (each [_ path (ipairs paths)]
      (set tgt (. tgt (pick-values 1 (path:gsub "%/" "."))))
      (if (= nil tgt) (lua :break)))
    tgt))

(fn apropos-doc [pattern]
  "Search function documentations for a given pattern."
  (let [names []]
    (each [_ path (ipairs (apropos ".*"))]
      (let [tgt (apropos-follow-path path)]
        (if (= :function (type tgt))
            (match (compiler.metadata:get tgt :fnl/docstring)
              docstr (when (docstr:match pattern)
                       (table.insert names path))))))
    names))

(fn commands.apropos-doc [env read on-values on-error scope]
  (match (pcall read)
    (true true input) (on-values (apropos-doc (tostring input)))
    (_ _ ?msg) (on-error :Parse (or ?msg "Couldn't parse apropos-doc input."))))

(compiler.metadata:set commands.apropos-doc :fnl/docstring
                       "Print all functions that match the pattern in their docs")

(fn apropos-show-docs [pattern]
  "Print function documentations for a given function pattern."
  (each [_ path (ipairs (apropos pattern))]
    (let [tgt (apropos-follow-path path)]
      (when (and (= :function (type tgt))
                 (compiler.metadata:get tgt :fnl/docstring))
        (print (specials.doc tgt path))
        (print)))))

(fn commands.apropos-show-docs [env read _ on-error scope]
  (match (pcall read)
    (true true input) (apropos-show-docs (tostring input))
    (_ _ ?msg) (on-error :Parse (or ?msg "Couldn't parse apropos-show-docs input."))))

(compiler.metadata:set commands.apropos-show-docs :fnl/docstring
                       "Print all documentations matching a pattern in function name")

(fn load-plugin-commands []
  (when (and utils.root utils.root.options utils.root.options.plugins)
    (each [_ plugin (ipairs utils.root.options.plugins)]

M test/repl.fnl => test/repl.fnl +27 -1
@@ 125,6 125,31 @@
      (l.assertEquals bxor-result [:0])
      (l.assertStrContains (. bxor-result 1) "error:.*attempt to index.*global 'bit'"
                           "--use-bit-lib should make bitops fail in non-luajit"))))

(fn test-apropos []
  (local (send) (wrap-repl))
  (let [res (. (send ",apropos table%.") 1)]
    (l.assertEquals
     (doto (icollect [item (res:gmatch "[^%s]+")] item)
       (table.sort))
     ["table.concat" "table.insert" "table.move"

      "table.pack" "table.remove" "table.sort"
      "table.unpack"]
     "apropos returns all matching patterns"))
  (let [res (. (send ",apropos not-found") 1)]
    (l.assertEquals res "" "apropos returns no results for unknown pattern")
    (l.assertEquals
     (doto (icollect [item (res:gmatch "[^%s]+")] item)
       (table.sort))
     []
     "apropos returns no results for unknown pattern"))
  (let [res (. (send ",apropos-doc function") 1)]
    (l.assertStrContains res "partial" "apropos returns matching doc patterns")
    (l.assertStrContains res "pick%-args" "apropos returns matching doc patterns"))
  (let [res (. (send ",apropos-doc \"there's no way this could match\"") 1)]
    (l.assertEquals res "" "apropos returns no results for unknown doc pattern")))

;; Skip REPL tests in non-JIT Lua 5.1 only to avoid engine coroutine
;; limitation. Normally we want all tests to run on all versions, but in
;; this case the feature will work fine; we just can't use this method of


@@ 138,5 163,6 @@
     : test-reload
     : test-reset
     : test-plugins
     : test-options}
     : test-options
     : test-apropos}
    {})