.gitignore

*~

counsel-hoogle.el

;;; counsel-hoogle.el --- Counsel completion for Hoogle 5 -*- lexical-binding: t -*-

;; Copyright (C) 2016 Moritz Kiefer

;; Author: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>
;; URL: https://github.com/cocreature/counsel-hoogle
;; Package-Requires: ((emacs "24.1") (swiper "0.8.0") (dash "2.11.0") (s "1.11.0"))
;; Keywords: completion, matching

;;; Commentary:
;;
;; Ivy completion using the hoogle server.

;;; Code:

(require 'dash)
(require 's)
(require 'ivy)
(require 'json)

(defvar counsel-hoogle-port 8080
  "Port of the Hoogle server.")

(defvar counsel-hoogle-host "localhost"
  "Host the Hoogle server is running on.")

(defun get-candidates (search-string)
  "Get the hoogle candidates for SEARCH-STRING."
  (-map 'format-item
        (-map 'get-item
              (-filter
               (-lambda ((&alist 'type type)) (not (equal type "package")))
               (append (json-read-from-string
                        (shell-command-to-string
                         (format
                          "curl -s 'http://%s:%d/?&mode=json&hoogle=%s'"
                          counsel-hoogle-host counsel-hoogle-port (url-encode-url search-string)))) nil)))))

(defun counsel-hoogle ()
  "Find file in the current Git repository."
  (interactive)
  (ivy-read "Hoogle: "
            'get-candidates
            :action 'counsel-hoogle-action
            :dynamic-collection t
            :caller 'counsel-hoogle))

(defun counsel-hoogle-action (str)
  "Open the URL corresponding to the result STR."
  (browse-url (cadr (s-match ".*|\\(.*\\)" str))))

(defun counsel-hoogle-transformer (str)
  "Hide URL in STR."
  (message "calling transformer")
  (when (and str (string-match ".*\\(|.*\\)" str))
    (set-text-properties (match-beginning 1)
                         (match-end 1)
                         '(invisible t)
                         str))
  str)

(ivy-set-display-transformer 'counsel-hoogle 'counsel-hoogle-transformer)

(defadvice ivy--exhibit (around intercept activate)
  "This is used for debugging."
  (condition-case err
      ad-do-it
    ;; Let the debugger run
    ((debug error) (signal (car err) (cdr err)))))

(defun hoogle-matcher (regex candidates)
  "Match, ignoring the REGEX, all CANDIDATES."
  candidates)

(defun format-item (item)
  "Format ITEM."
  (pcase (cdr (assoc 'exprtype item))
    (`data (s-format "data ${name} — ${module} (${package}) |${url}" 'aget item))
    (`type-synonym (s-format "type ${name} — ${module} (${package}) |${url}" 'aget item))
    (`expr (s-format "${name} :: ${type} — ${module} (${package}) |${url}" 'aget item))))

(defun get-item (result)
  "Extract an item from the RESULT."
  (-let* (((&alist 'item item 'url url 'package (&alist 'name package) 'module (&alist 'name module)) result)
          ((_ name type) (s-match "^.*<0>\\(.*\\)</0>.*:: \\(.*\\)" item))
          ((_ dataname) (s-match "^.*<b>data</b>.*<0>\\(.*\\)</0>.*" item))
          ((_ typename) (s-match "^.*<b>type</b>.*<0>\\(.*\\)</0>.*" item))
          )
    `((url . ,url)
      (package . ,package)
      (module . ,module)
      (name . ,(or name dataname typename))
      (type . ,(if type (s-replace "&gt;" ">" type) nil))
      (exprtype . ,(cond (type 'expr) (dataname 'data) (typename 'type-synonym))))))

(provide 'counsel-hoogle)
;;; counsel-hoogle.el ends here