blob: a93803b51794d5315ab7150be558fc4ad11775b1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
;;; semgrep.el --- Semantic search -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2023 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: November 07, 2023
;; Modified: November 07, 2023
;; Version: 0.0.1
;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp
;; Homepage: https://github.com/titan/semgrep
;; Package-Requires: ((emacs "27.1"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; semantically search on my database by paragraph
;;
;;; Code:
(require 'url)
(require 'org-element)
(require 'org-roam-db)
(require 'dash)
;; Silence byte-compiler.
(defvar url-http-end-of-headers)
(defun semgrep--connect (method data)
(let ((url-request-method "POST")
(url-request-extra-headers '(("Content-Type" . "application/json")))
(url-request-data (encode-coding-string
(json-serialize `(,method ,data))
'utf-8)))
(with-current-buffer
(url-retrieve-synchronously "http://localhost:8080")
(goto-char url-http-end-of-headers)
(json-read))))
(defun semgrep--get-node-id (paragraph &optional default)
(-->
(org-element-map
(org-element-property :parent paragraph)
'node-property
(lambda (np)
(cons
(org-element-property :key np)
(org-element-property :value np))))
(assoc 'ID it #'string=)
(cdr it)
(org-string-nw-p it)
(or it default)))
(defun semgrep--prepare-paragraph (file-id)
(lambda (paragraph)
(list
:document (substring-no-properties (org-element-interpret-data paragraph))
:metadata (list :start-point
(org-element-property :begin paragraph)
:node-id
(semgrep--get-node-id paragraph file-id)))))
(defun semgrep--add-buffer ()
(interactive)
(if (eq major-mode 'org-mode)
(-some-->
(org-element-map
(org-element-parse-buffer)
'paragraph
(semgrep--prepare-paragraph (org-id-get (point-min) 'create)))
(cl-coerce it 'vector)
;; (json-serialize it)
;; (f-write it 'utf-8 "/tmp/out.json")
;; (message "%S" it)
(semgrep--connect :insert it))
(user-error "This only works on org-mode")))
(defun semgrep--roam-data (entries)
(thread-last
(cl-mapcar (lambda (meta)
(alist-get 'node-id meta))
entries)
(delete-dups)
(vconcat)
(org-roam-db-query [:select [id title file]
:from nodes
:where (in id $v1)])))
(defun semgrep-pick-org-element ()
(when-let ((context (ignore-errors (org-element-context))))
(filter-buffer-substring (org-element-property :begin context)
(org-element-property :end context))))
(defun semgrep--sync-db ()
(org-roam-dolist-with-progress (file (nreverse (org-roam-list-files)))
"importing to semantic search"
(org-roam-with-file file nil
(semgrep--add-buffer))))
;; (semgrep--sync-db)
(defun semgrep-search (text)
(interactive (list (or (semgrep-pick-org-element)
(read-from-minibuffer "What are you looking for? "))))
(-let (((&alist 'distances 'documents 'metadatas)
(semgrep--connect :query text)))
(with-current-buffer (get-buffer-create "*Semantic Search*")
(erase-buffer)
(org-mode)
(insert "#+title: Looking for:\n" text "\n")
(cl-mapc
(lambda (entry-distances entry-document entry-metadatas)
(let ((data (semgrep--roam-data entry-metadatas)))
(cl-mapc
(lambda (d paragraph meta)
(unless (zerop d)
(-let* ((node-id (alist-get 'node-id meta))
((_ title file) (assoc node-id data #'string=))
(pos
(with-temp-buffer
(insert-file-contents file)
(line-number-at-pos (or (alist-get 'start-point meta) 1)))))
(insert
(format "* [[file:%s::%d][%s]]\n" file pos title)
"- Distance :: " (number-to-string d) "\n"
paragraph ?\n)
(org-fill-paragraph))))
entry-distances entry-document entry-metadatas)))
distances documents metadatas)
(goto-char (point-min))
(display-buffer (current-buffer)))))
(provide 'semgrep)
;;; semgrep.el ends here
|
