3 files changed, 106 insertions(+), 1 deletions(-)

M changelog.md
M src/fennel/repl.fnl
M test/repl.fnl

@@ 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`

@@ 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)]

@@ 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}
     {})