;; -*- lexical-binding: t; -*- ;; data conversions (defun hcel-parse-package-id (package-id &optional divider) (unless (stringp divider) (setq divider " ")) (string-match (format "^\\(.*\\)%s\\(.*\\)$" divider) package-id) (list (cons 'name (match-string 1 package-id)) (cons 'version (match-string 2 package-id)))) (defun hcel-location-tag (location-info) "Gets the tag of LOCATION-INFO." (alist-get 'tag location-info)) (defun hcel-approx-to-exact-location (approx-location-info) "Fetch exact location given approximate location. Example of approximate location: \"locationInfo\": { \"componentId\": \"exe-haskell-code-server\", \"entity\": \"Typ\", \"haddockAnchorId\": \"PackageInfo\", \"moduleName\": \"HaskellCodeExplorer.Types\", \"name\": \"PackageInfo\", \"packageId\": { \"name\": \"haskell-code-explorer\", \"version\": \"0.1.0.0\" }, \"tag\": \"ApproximateLocation\" }" (alist-get 'location (hcel-definition-site-location-info approx-location-info))) (defun hcel-id-src-span-to-location-info (package-id module-path id-src-span) "Converts an idSrcSpan to an exact location. Example of an idSrcSpan: \"idSrcSpan\": { \"endColumn\": 43, \"line\": 228, \"modulePath\": \"src/HaskellCodeExplorer/Types.hs\", \"startColumn\": 26 } " (list (cons 'packageId package-id) (cons 'modulePath module-path) (cons 'startLine (alist-get 'line id-src-span)) (cons 'startColumn (alist-get 'startColumn id-src-span)) (cons 'endLine (alist-get 'line id-src-span)) (cons 'endColumn (alist-get 'endColumn id-src-span)) (cons 'tag "ExactLocation"))) (defun hcel-expression (expr) (when-let* ((span (alist-get 'srcSpan expr)) (line-beg (alist-get 'line (alist-get 'start span))) (col-beg (alist-get 'column (alist-get 'start span))) (line-end (alist-get 'line (alist-get 'end span))) (col-end (alist-get 'column (alist-get 'end span)))) (buffer-substring-line-column line-beg (1- col-beg) line-end (1- col-end)))) ;; buffers and strings manipulation (defun goto-line-column (line column) (goto-line line) (move-to-column column)) (defun hcel-unquote-html (html) (replace-regexp-in-string "&" "&" (replace-regexp-in-string "'" "'" (replace-regexp-in-string """ "\"" (replace-regexp-in-string ">" ">" (replace-regexp-in-string "<" "<" html)))))) (defun buffer-substring-line-column (line-beg col-beg line-end col-end) (save-excursion (buffer-substring (progn (goto-line-column line-beg col-beg) (point)) (progn (goto-line-column line-end col-end) (point))))) (defun fontify-with-haskell-mode () "Fontify using haskell-mode" (require 'haskell) (let ((text (buffer-string))) (with-temp-buffer (haskell-mode) (insert text) (if (fboundp 'font-lock-ensure) (font-lock-ensure) (with-no-warnings (font-lock-fontify-buffer))) (setq text (buffer-substring (point-min) (point-max)))) (erase-buffer) (insert text))) (defun remove-html-markup (html) (replace-regexp-in-string "<.*?>" "" (replace-regexp-in-string "

" "\n\n" html))) (defun fill-string (text) (with-temp-buffer (insert text) (fill-region (point-min) (point-max)) (buffer-substring (point-min) (point-max)))) ;; string formatting (defun hcel-format-package-id (package &optional divider) (unless (stringp divider) (setq divider " ")) (concat (alist-get 'name package) divider (alist-get 'version package))) (defun hcel-render-components (components &optional name) (when (or components name) (concat (when name (replace-regexp-in-string "\n" " " name)) (when components (concat (when name " :: ") (replace-regexp-in-string "\n" " " (mapconcat (lambda (component) (propertize (or (alist-get 'name component) (alist-get 'contents component)) 'internal-id (alist-get 'internalId component))) components ""))))))) (defun hcel-render-id-type (id-type) (concat (hcel-render-components (alist-get 'components id-type)) (when-let ((expanded (hcel-render-components (alist-get 'componentsExpanded id-type)))) (concat "\nExpands to: " expanded)))) (defun hcel-expression-and-type (expr) "Returns a pair of expression text and its type text." (when-let ((expression (hcel-expression expr)) (type (hcel-render-id-type (alist-get 'exprType (alist-get 'info expr))))) (cons expression type))) (defun hcel-render-html (html) (when html (with-temp-buffer (insert html) (shr-render-region (point-min) (point-max)) (buffer-string)))) (provide 'hcel-utils)