Applicative hack.

This commit is contained in:
Kazu Yamamoto 2012-01-23 18:30:07 +09:00
parent cc6a2d7070
commit 34d22ee1d5
3 changed files with 54 additions and 8 deletions

View File

@ -100,7 +100,7 @@ main = flip catches handlers $ do
mods <- listModules opt mods <- listModules opt
langs <- listLanguages opt langs <- listLanguages opt
flags <- listFlags opt flags <- listFlags opt
pre <- browseModule opt "Prelude" pre <- concat <$> mapM (browseModule opt) preBrowsedModules
return $ mods ++ langs ++ flags ++ pre return $ mods ++ langs ++ flags ++ pre
cmd -> throw (NoSuchCommand cmd) cmd -> throw (NoSuchCommand cmd)
putStr res putStr res
@ -138,3 +138,17 @@ toLisp ms = "(" ++ unwords quoted ++ ")\n"
toPlain :: [String] -> String toPlain :: [String] -> String
toPlain = unlines toPlain = unlines
----------------------------------------------------------------
preBrowsedModules :: [String]
preBrowsedModules = [
"Prelude"
, "Control.Applicative"
, "Control.Monad"
, "Control.Exception"
, "Data.Char"
, "Data.List"
, "Data.Maybe"
, "System.IO"
]

View File

@ -53,19 +53,40 @@ unloaded modules are loaded")
(defconst ghc-keyword-prefix "ghc-keyword-") (defconst ghc-keyword-prefix "ghc-keyword-")
(defvar ghc-keyword-Prelude nil) (defvar ghc-keyword-Prelude nil)
(defvar ghc-keyword-Control.Applicative nil)
(defvar ghc-keyword-Control.Monad nil)
(defvar ghc-keyword-Control.Exception nil)
(defvar ghc-keyword-Data.Char nil)
(defvar ghc-keyword-Data.List nil)
(defvar ghc-keyword-Data.Maybe nil)
(defvar ghc-keyword-System.IO nil)
(defvar ghc-loaded-module nil) (defvar ghc-loaded-module nil)
(defun ghc-comp-init () (defun ghc-comp-init ()
(let* ((syms '(ghc-module-names (let* ((syms '(ghc-module-names
ghc-language-extensions ghc-language-extensions
ghc-option-flags ghc-option-flags
ghc-keyword-Prelude)) ghc-keyword-Prelude
ghc-keyword-Control.Applicative
ghc-keyword-Control.Monad
ghc-keyword-Control.Exception
ghc-keyword-Data.Char
ghc-keyword-Data.List
ghc-keyword-Data.Maybe
ghc-keyword-System.IO))
(vals (ghc-boot (length syms)))) (vals (ghc-boot (length syms))))
(ghc-set syms vals)) (ghc-set syms vals))
(ghc-add ghc-module-names "qualified") (ghc-add ghc-module-names "qualified")
(ghc-add ghc-module-names "hiding") (ghc-add ghc-module-names "hiding")
;; (ghc-add ghc-language-extensions "LANGUAGE") (ghc-merge-keywords '("Prelude"
(ghc-merge-keywords '("Prelude")) "Control.Applicative"
"Control.Monad"
"Control.Exception"
"Data.Char"
"Data.List"
"Data.Maybe"
"System.IO"))
(run-with-idle-timer ghc-idle-timer-interval 'repeat 'ghc-idle-timer)) (run-with-idle-timer ghc-idle-timer-interval 'repeat 'ghc-idle-timer))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -39,12 +39,23 @@
(unless (re-search-forward "^$" nil t) (unless (re-search-forward "^$" nil t)
(forward-line))) (forward-line)))
;; To avoid Data.Functor
(defvar ghc-applicative-operators '("<$>" "<$" "<*>" "<**>" "<*" "*>" "<|>"))
(defun ghc-function-to-modules (fn) (defun ghc-function-to-modules (fn)
(if (member fn ghc-applicative-operators)
'("Control.Applicative")
(ghc-function-to-modules-hoogle fn)))
(defun ghc-function-to-modules-hoogle (fn)
(with-temp-buffer (with-temp-buffer
(call-process ghc-hoogle-command nil t nil "search" fn) (let* ((fn1 (if (string-match "^[a-zA-Z0-9'_]+$" fn)
(goto-char (point-min)) fn
(let ((regex (concat "^\\([a-zA-Z0-9.]+\\) " fn " ")) (concat "(" fn ")")))
(regex (concat "^\\([a-zA-Z0-9.]+\\) " fn1 " "))
ret) ret)
(call-process ghc-hoogle-command nil t nil "search" fn1)
(goto-char (point-min))
(while (re-search-forward regex nil t) (while (re-search-forward regex nil t)
(setq ret (cons (match-string 1) ret))) (setq ret (cons (match-string 1) ret)))
(nreverse ret)))) (nreverse ret))))