initial import (v0.1)
This commit is contained in:
Kazu Yamamoto
commit
35f60507c6
241
GHCMod.hs
Normal file
241
GHCMod.hs
Normal file
@ -0,0 +1,241 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Control.Exception hiding (try)
|
||||||
|
import Data.Char
|
||||||
|
import Data.List
|
||||||
|
import Language.Haskell.Exts.Extension
|
||||||
|
import Language.Haskell.Exts.Parser hiding (parse)
|
||||||
|
import Language.Haskell.Exts.Syntax
|
||||||
|
import Prelude hiding (catch)
|
||||||
|
import System.Console.GetOpt
|
||||||
|
import System.Environment
|
||||||
|
import System.IO
|
||||||
|
import System.Process
|
||||||
|
import Text.ParserCombinators.Parsec
|
||||||
|
|
||||||
|
import Debug.Trace
|
||||||
|
infixr 0 .$.
|
||||||
|
(.$.) :: Show a => (a -> b) -> a -> b
|
||||||
|
f .$. x = trace (show x) f x
|
||||||
|
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
usage :: String
|
||||||
|
usage = "ghc-mod putStrLn version 0.1\n"
|
||||||
|
++ "Usage:\n"
|
||||||
|
++ "\t ghc-mod list\n"
|
||||||
|
++ "\t ghc-mod browse <module>\n"
|
||||||
|
++ "\t ghc-mod help\n"
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
data Options = Options { optToLisp :: Bool
|
||||||
|
} deriving Show
|
||||||
|
|
||||||
|
defaultOptions :: Options
|
||||||
|
defaultOptions = Options { optToLisp = False
|
||||||
|
}
|
||||||
|
|
||||||
|
argspec :: [OptDescr (Options -> Options)]
|
||||||
|
argspec = [ Option ['l'] ["tolisp"]
|
||||||
|
(NoArg (\opts -> opts { optToLisp = True }))
|
||||||
|
"print as a list of Lisp"
|
||||||
|
]
|
||||||
|
|
||||||
|
parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
|
||||||
|
parseArgs spec argv
|
||||||
|
= case getOpt Permute spec argv of
|
||||||
|
(o,n,[] ) -> (foldl (flip id) defaultOptions o, n)
|
||||||
|
(_,_,errs) -> error (concat errs ++ usageInfo usage argspec)
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = flip catch handler $ do
|
||||||
|
args <- getArgs
|
||||||
|
let (opt,cmdArg) = parseArgs argspec args
|
||||||
|
transform = if optToLisp opt then toLisp else toPlain
|
||||||
|
ll <- case cmdArg !! 0 of
|
||||||
|
cmd | cmd == "browse" -> browseModule $ cmdArg !! 1
|
||||||
|
| cmd == "list" -> listModules
|
||||||
|
_ -> error usage
|
||||||
|
putStr $ transform $ nub $ sort $ ll
|
||||||
|
where
|
||||||
|
handler :: ErrorCall -> IO ()
|
||||||
|
-- handler _ = print usage
|
||||||
|
handler e = print e
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
browseModule :: String -> IO [String]
|
||||||
|
browseModule mname = do
|
||||||
|
xs <- getSyntax mname
|
||||||
|
let ys = preprocess xs
|
||||||
|
return $ parseSyntax ys
|
||||||
|
|
||||||
|
getSyntax :: String -> IO String
|
||||||
|
getSyntax mname = do
|
||||||
|
(inp,out,_,_) <- runInteractiveProcess "ghci" [] Nothing Nothing
|
||||||
|
mapM_ setFD [inp,out]
|
||||||
|
hPutStrLn inp ":set prompt \"\""
|
||||||
|
hPutStrLn inp "1"
|
||||||
|
hPutStrLn inp $ ":browse " ++ mname
|
||||||
|
hPutStrLn inp ":set prompt \"Prelude>\""
|
||||||
|
hPutStrLn inp ":quit"
|
||||||
|
cs <- hGetContents out
|
||||||
|
return $ unlines $ dropTailer $ dropHeader $ lines $ cs
|
||||||
|
where
|
||||||
|
isNotPrefixOf x y = not (x `isPrefixOf` y)
|
||||||
|
dropHeader xs = tail $ dropWhile (isNotPrefixOf "Prelude>") xs
|
||||||
|
dropTailer = takeWhile (isNotPrefixOf "Prelude>")
|
||||||
|
setFD h = do
|
||||||
|
hSetBinaryMode h False
|
||||||
|
hSetBuffering h LineBuffering
|
||||||
|
|
||||||
|
parseSyntax :: String -> [String]
|
||||||
|
parseSyntax xs = do
|
||||||
|
let mode = defaultParseMode { extensions = NewQualifiedOperators : ExplicitForall : glasgowExts }
|
||||||
|
res = parseModuleWithMode mode xs
|
||||||
|
case res of
|
||||||
|
ParseOk x -> identifiers x
|
||||||
|
-- e -> error $ show e
|
||||||
|
_ -> []
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
listModules :: IO [String]
|
||||||
|
listModules = do
|
||||||
|
cs <- getDump
|
||||||
|
return $ exposedModules cs
|
||||||
|
|
||||||
|
getDump :: IO String
|
||||||
|
getDump = do
|
||||||
|
(_,hout,_,_) <- runInteractiveProcess "ghc-pkg" ["dump"] Nothing Nothing
|
||||||
|
hGetContents hout
|
||||||
|
|
||||||
|
exposedModules :: String -> [String]
|
||||||
|
exposedModules cs = let ls = unfoldLines cs
|
||||||
|
ns = values "name: " ls
|
||||||
|
ms = values "exposed-modules: " ls
|
||||||
|
zs = zip ns ms
|
||||||
|
xs = filter (\(nm,_) -> nm `notElem` ["ghc", "ghc-prim", "rts", "integer"]) zs
|
||||||
|
ss = map snd xs
|
||||||
|
in filter (\x -> not ("GHC" `isPrefixOf` x)) $ concatMap words ss
|
||||||
|
|
||||||
|
values :: String -> [String] -> [String]
|
||||||
|
values tag ls = let len = length tag
|
||||||
|
fs = filter (tag `isPrefixOf`) ls
|
||||||
|
in map (drop len) fs
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
unfoldLines :: String -> [String]
|
||||||
|
unfoldLines xs = self xs
|
||||||
|
where
|
||||||
|
splitNL = break (== '\n')
|
||||||
|
self "" = []
|
||||||
|
self s = let (l, s') = splitNL s
|
||||||
|
in case s' of
|
||||||
|
[] -> [l]
|
||||||
|
(_:' ':s'') -> cont s'' l
|
||||||
|
(_:s'') -> l : self s''
|
||||||
|
cont s a = let (l, s') = splitNL $ dropWhile (== ' ') s
|
||||||
|
a' = a ++ " " ++ l
|
||||||
|
in case s' of
|
||||||
|
[] -> [a']
|
||||||
|
(_:' ':s'') -> cont s'' a'
|
||||||
|
(_:s'') -> a' : self s''
|
||||||
|
|
||||||
|
toLisp :: [String] -> String
|
||||||
|
toLisp ms = "(" ++ unwords quoted ++ ")\n"
|
||||||
|
where
|
||||||
|
quote x = "\"" ++ x ++ "\""
|
||||||
|
quoted = map quote ms
|
||||||
|
|
||||||
|
toPlain :: [String] -> String
|
||||||
|
toPlain = unlines
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
preprocess :: String -> String
|
||||||
|
preprocess cs = case parse remove "remove" cs of
|
||||||
|
Right a -> a
|
||||||
|
Left e -> error $ show e
|
||||||
|
|
||||||
|
modName :: Parser String
|
||||||
|
modName = do c <- oneOf ['A'..'Z']
|
||||||
|
cs <- many1 $ oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#"
|
||||||
|
return $ c:cs
|
||||||
|
|
||||||
|
anyName :: Parser String
|
||||||
|
anyName = many1 $ oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#"
|
||||||
|
|
||||||
|
manyBefore :: Show tok => GenParser tok st a -> GenParser tok st [tok] -> GenParser tok st [a]
|
||||||
|
manyBefore p anchor = manyTill p (eof <|> try anc)
|
||||||
|
where
|
||||||
|
anc = do pos <- getPosition
|
||||||
|
s <- anchor
|
||||||
|
ss <- getInput
|
||||||
|
setInput $ s ++ ss
|
||||||
|
setPosition pos
|
||||||
|
return ()
|
||||||
|
|
||||||
|
keyword :: Parser String
|
||||||
|
keyword = do ms <- modName
|
||||||
|
char '.'
|
||||||
|
return $ ms ++ ['.']
|
||||||
|
|
||||||
|
ghcName :: Parser String
|
||||||
|
ghcName = do keyword
|
||||||
|
try sep <|> end
|
||||||
|
where
|
||||||
|
sep = do
|
||||||
|
ws <- sepBy1 anyName (char '.')
|
||||||
|
return $ last ws
|
||||||
|
end = do
|
||||||
|
endBy1 anyName (char '.')
|
||||||
|
return ""
|
||||||
|
|
||||||
|
nonGhcName :: Parser String
|
||||||
|
nonGhcName = do c <- anyChar -- making this func non-empty
|
||||||
|
cs <- manyBefore anyChar keyword
|
||||||
|
return $ c:cs
|
||||||
|
|
||||||
|
remove :: Parser String
|
||||||
|
remove = do l1 <- try ghcName <|> return ""
|
||||||
|
l2 <- nonGhcName
|
||||||
|
ll <- many (do x <- ghcName
|
||||||
|
y <- nonGhcName
|
||||||
|
return $ x ++ y)
|
||||||
|
return $ concat $ l1 : l2 : ll
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
identifiers :: Module -> [String]
|
||||||
|
identifiers (Module _ _ _ _ _ _ x) = filter hid $ concatMap decl x
|
||||||
|
where
|
||||||
|
hid = all (\c -> isAlphaNum c || elem c "_'")
|
||||||
|
|
||||||
|
decl :: Decl -> [String]
|
||||||
|
decl (TypeSig _ [x] _) = [name x]
|
||||||
|
decl (DataDecl _ _ _ x _ y _) = name x : (map qualConDecl y)
|
||||||
|
decl (ClassDecl _ _ x _ _ y) = name x : (map classDecl y)
|
||||||
|
decl (TypeDecl _ x _ _) = [name x]
|
||||||
|
decl x = [show x]
|
||||||
|
|
||||||
|
qualConDecl :: QualConDecl -> String
|
||||||
|
qualConDecl (QualConDecl _ _ _ x) = conDecl x
|
||||||
|
|
||||||
|
conDecl :: ConDecl -> String
|
||||||
|
conDecl (ConDecl (Ident x) _) = x
|
||||||
|
conDecl (InfixConDecl _ (Ident x) _) = x
|
||||||
|
conDecl x = show x
|
||||||
|
|
||||||
|
classDecl :: ClassDecl -> String
|
||||||
|
classDecl (ClsDecl x) = concat $ decl x -- xxx
|
||||||
|
classDecl x = show x
|
||||||
|
|
||||||
|
name :: Name -> String
|
||||||
|
name (Symbol x) = x
|
||||||
|
name (Ident x) = x
|
||||||
16
elisp/Makefile
Normal file
16
elisp/Makefile
Normal file
@ -0,0 +1,16 @@
|
|||||||
|
SRCS = ghc.el ghc-func.el ghc-doc.el ghc-comp.el
|
||||||
|
|
||||||
|
TEMPFILE = temp.el
|
||||||
|
|
||||||
|
all: $(TEMPFILE) ghc.el
|
||||||
|
emacs -batch -q -no-site-file -l ./$(TEMPFILE) -f ghc-compile
|
||||||
|
|
||||||
|
$(TEMPFILE):
|
||||||
|
@echo '(setq load-path (cons "." load-path))' >> $(TEMPFILE)
|
||||||
|
@echo '(defun ghc-compile () (mapcar (lambda (x) (byte-compile-file x)) (list ' >> $(TEMPFILE)
|
||||||
|
@echo $(SRCS)| sed -e 's/\(ghc[^ ]*\.el\)/"\1"/g' >> $(TEMPFILE)
|
||||||
|
@echo ')))' >> $(TEMPFILE)
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -f *.elc $(TEMPFILE)
|
||||||
|
|
||||||
183
elisp/ghc-comp.el
Normal file
183
elisp/ghc-comp.el
Normal file
@ -0,0 +1,183 @@
|
|||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; ghc-comp.el
|
||||||
|
;;;
|
||||||
|
|
||||||
|
;; Author: Kazu Yamamoto <Kazu@Mew.org>
|
||||||
|
;; Created: Sep 25, 2009
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'ghc-func)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Customize Variables
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defvar ghc-module-command "ghc-mod")
|
||||||
|
|
||||||
|
(defvar ghc-idle-timer-interval 30)
|
||||||
|
|
||||||
|
;; must be sorted
|
||||||
|
(defvar ghc-reserved-keyword-for-bol '("class" "data" "default" "import" "infix" "infixl" "infixr" "instance" "main" "module" "newtype" "type"))
|
||||||
|
|
||||||
|
;; must be sorted
|
||||||
|
(defvar ghc-reserved-keyword '("case" "deriving" "do" "else" "if" "in" "let" "module" "of" "then" "where"))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Initializer
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defvar ghc-module-names nil) ;; completion for "import"
|
||||||
|
(defvar ghc-merged-keyword nil) ;; completion for type/func/...
|
||||||
|
|
||||||
|
(defvar ghc-keyword-prefix "ghc-keyword-")
|
||||||
|
(defvar ghc-keyword-Prelude nil)
|
||||||
|
(defvar ghc-loaded-module nil)
|
||||||
|
|
||||||
|
(defun ghc-comp-init ()
|
||||||
|
(setq ghc-module-names (ghc-load-keyword "list"))
|
||||||
|
(setq ghc-keyword-Prelude (ghc-load-keyword "browse" "Prelude"))
|
||||||
|
(setq ghc-loaded-module '("Prelude"))
|
||||||
|
(ghc-merge-keywords)
|
||||||
|
(run-with-idle-timer ghc-idle-timer-interval 'repeat 'ghc-idle-timer))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Executing command
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defun ghc-load-keyword (&rest args)
|
||||||
|
(when (ghc-which ghc-module-command)
|
||||||
|
(ghc-read-lisp
|
||||||
|
(lambda ()
|
||||||
|
(let ((msg (mapconcat 'identity (cons ghc-module-command args) " ")))
|
||||||
|
(message "Executing \"%s\"..." msg)
|
||||||
|
(apply 'call-process-shell-command
|
||||||
|
ghc-module-command nil t nil (cons "-l" args))
|
||||||
|
(message "Executing \"%s\"...done" msg))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Completion
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defvar ghc-completion-buffer-name "*Completions*")
|
||||||
|
|
||||||
|
(defun ghc-complete ()
|
||||||
|
(interactive)
|
||||||
|
(if (ghc-should-scroll)
|
||||||
|
(ghc-scroll-completion-buffer)
|
||||||
|
(ghc-try-complete)))
|
||||||
|
|
||||||
|
(defun ghc-should-scroll ()
|
||||||
|
(let ((window (ghc-completion-window)))
|
||||||
|
(and (eq last-command this-command)
|
||||||
|
window (window-live-p window) (window-buffer window)
|
||||||
|
(buffer-name (window-buffer window)))))
|
||||||
|
|
||||||
|
(defun ghc-scroll-completion-buffer ()
|
||||||
|
(let ((window (ghc-completion-window)))
|
||||||
|
(with-current-buffer (window-buffer window)
|
||||||
|
(if (pos-visible-in-window-p (point-max) window)
|
||||||
|
(set-window-start window (point-min))
|
||||||
|
(save-selected-window
|
||||||
|
(select-window window)
|
||||||
|
(scroll-up))))))
|
||||||
|
|
||||||
|
(defun ghc-completion-window ()
|
||||||
|
(get-buffer-window ghc-completion-buffer-name 0))
|
||||||
|
|
||||||
|
(defun ghc-try-complete ()
|
||||||
|
(let* ((end (point))
|
||||||
|
(symbols (ghc-select-completion-symbol))
|
||||||
|
(beg (ghc-completion-start-point))
|
||||||
|
(pattern (buffer-substring-no-properties beg end))
|
||||||
|
(completion (try-completion pattern symbols)))
|
||||||
|
(cond
|
||||||
|
((eq completion t) ;; completed
|
||||||
|
) ;; do nothing
|
||||||
|
((null completion) ;; no completions
|
||||||
|
(ding))
|
||||||
|
((not (string= pattern completion)) ;; ???
|
||||||
|
(delete-region beg end)
|
||||||
|
(insert completion)
|
||||||
|
(delete-other-windows))
|
||||||
|
(t ;; multiple completions
|
||||||
|
(let* ((list0 (all-completions pattern symbols))
|
||||||
|
(list (sort list0 'string<)))
|
||||||
|
(if (> (length list) 1)
|
||||||
|
(with-output-to-temp-buffer ghc-completion-buffer-name
|
||||||
|
(display-completion-list list pattern))
|
||||||
|
(delete-other-windows)))))))
|
||||||
|
|
||||||
|
(defun ghc-select-completion-symbol ()
|
||||||
|
(cond
|
||||||
|
((or (minibufferp)
|
||||||
|
(save-excursion
|
||||||
|
(beginning-of-line)
|
||||||
|
(looking-at "import ")))
|
||||||
|
ghc-module-names)
|
||||||
|
((or (bolp)
|
||||||
|
(let ((end (point)))
|
||||||
|
(save-excursion
|
||||||
|
(beginning-of-line)
|
||||||
|
(not (search-forward " " end t)))))
|
||||||
|
ghc-reserved-keyword-for-bol)
|
||||||
|
(t ghc-merged-keyword)))
|
||||||
|
|
||||||
|
(defun ghc-completion-start-point ()
|
||||||
|
(save-excursion
|
||||||
|
(let ((beg (save-excursion (beginning-of-line) (point))))
|
||||||
|
(if (search-backward " " beg t)
|
||||||
|
(1+ (point))
|
||||||
|
beg))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Background Idle Timer
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defun ghc-idle-timer ()
|
||||||
|
(let ((mods (ghc-gather-import-modules))
|
||||||
|
keywords)
|
||||||
|
(dolist (mod mods)
|
||||||
|
(when (and (member mod ghc-module-names)
|
||||||
|
(not (member mod ghc-loaded-module)))
|
||||||
|
(setq keywords (ghc-load-keyword "browse" mod))
|
||||||
|
(when (or (consp keywords) (null keywords))
|
||||||
|
(set (intern (concat ghc-keyword-prefix mod)) keywords)
|
||||||
|
(setq ghc-loaded-module (cons mod ghc-loaded-module)))))
|
||||||
|
(ghc-merge-keywords)))
|
||||||
|
|
||||||
|
(defun ghc-gather-import-modules ()
|
||||||
|
(let ((bufs (mapcar 'buffer-name (buffer-list)))
|
||||||
|
ret)
|
||||||
|
(save-excursion
|
||||||
|
(dolist (buf bufs)
|
||||||
|
(when (string-match "\\.hs$" buf)
|
||||||
|
(set-buffer buf)
|
||||||
|
(setq ret (cons (ghc-gather-import-modules-buffer) ret)))))
|
||||||
|
(ghc-uniq-lol ret)))
|
||||||
|
|
||||||
|
(defun ghc-gather-import-modules-buffer ()
|
||||||
|
(let (ret)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (re-search-forward "^import *\\([^\n ]+\\)" nil t)
|
||||||
|
(setq ret (cons (match-string-no-properties 1) ret))
|
||||||
|
(forward-line)))
|
||||||
|
ret))
|
||||||
|
|
||||||
|
(defun ghc-merge-keywords ()
|
||||||
|
(let* ((modkeys (mapcar 'ghc-module-keyword ghc-loaded-module))
|
||||||
|
(keywords (cons ghc-reserved-keyword modkeys))
|
||||||
|
(uniq-sorted (sort (ghc-uniq-lol keywords) 'string<)))
|
||||||
|
(setq ghc-merged-keyword uniq-sorted)))
|
||||||
|
|
||||||
|
(defun ghc-module-keyword (mod)
|
||||||
|
(symbol-value (intern (concat ghc-keyword-prefix mod))))
|
||||||
|
|
||||||
|
(provide 'ghc-comp)
|
||||||
64
elisp/ghc-doc.el
Normal file
64
elisp/ghc-doc.el
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; ghc.el
|
||||||
|
;;;
|
||||||
|
|
||||||
|
;; Author: Kazu Yamamoto <Kazu@Mew.org>
|
||||||
|
;; Created: Sep 25, 2009
|
||||||
|
|
||||||
|
(require 'ghc-func)
|
||||||
|
(require 'ghc-comp)
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defun ghc-browse-document ()
|
||||||
|
(interactive)
|
||||||
|
(let* ((mod0 (ghc-extract-module))
|
||||||
|
(mod (ghc-read-module-name mod0))
|
||||||
|
(pkg (ghc-resolve-package-name mod)))
|
||||||
|
(ghc-display-document pkg mod)))
|
||||||
|
|
||||||
|
(defun ghc-extract-module ()
|
||||||
|
(interactive)
|
||||||
|
(save-excursion
|
||||||
|
(beginning-of-line)
|
||||||
|
(when (looking-at "^import +\\([^ \n]+\\)")
|
||||||
|
(match-string-no-properties 1))))
|
||||||
|
|
||||||
|
(defun ghc-resolve-package-name (mod)
|
||||||
|
(with-temp-buffer
|
||||||
|
(call-process "ghc-pkg" nil t nil "find-module" "--simple-output" mod)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(when (looking-at "^\\([^-]+\\)-")
|
||||||
|
(match-string-no-properties 1))))
|
||||||
|
|
||||||
|
(defun ghc-resolve-document-path (pkg)
|
||||||
|
(with-temp-buffer
|
||||||
|
(call-process "ghc-pkg" nil t nil "field" pkg "haddock-html")
|
||||||
|
(goto-char (point-min))
|
||||||
|
(when (looking-at "^haddock-html: \\([^ \n]+\\)$")
|
||||||
|
(match-string-no-properties 1))))
|
||||||
|
|
||||||
|
(defun ghc-display-document (pkg mod)
|
||||||
|
(when (and pkg mod)
|
||||||
|
(let* ((mod- (ghc-replace-character mod ?. ?-))
|
||||||
|
(path (ghc-resolve-document-path pkg))
|
||||||
|
(url (format "file://%s/%s.html" path mod-)))
|
||||||
|
(browse-url url))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defvar ghc-input-map nil)
|
||||||
|
|
||||||
|
(unless ghc-input-map
|
||||||
|
(setq ghc-input-map
|
||||||
|
(if (boundp 'minibuffer-local-map)
|
||||||
|
(copy-keymap minibuffer-local-map)
|
||||||
|
(make-sparse-keymap)))
|
||||||
|
(define-key ghc-input-map "\t" 'ghc-complete))
|
||||||
|
|
||||||
|
(defun ghc-read-module-name (def)
|
||||||
|
(read-from-minibuffer "Module name: " def ghc-input-map))
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'ghc-doc)
|
||||||
41
elisp/ghc-func.el
Normal file
41
elisp/ghc-func.el
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; ghc-func.el
|
||||||
|
;;;
|
||||||
|
|
||||||
|
;; Author: Kazu Yamamoto <Kazu@Mew.org>
|
||||||
|
;; Created: Sep 25, 2009
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defun ghc-replace-character (string from to)
|
||||||
|
"Replace characters equal to FROM to TO in STRING."
|
||||||
|
(dotimes (cnt (length string) string)
|
||||||
|
(if (char-equal (aref string cnt) from)
|
||||||
|
(aset string cnt to))))
|
||||||
|
|
||||||
|
(defun ghc-which (cmd)
|
||||||
|
(catch 'loop
|
||||||
|
(dolist (dir exec-path)
|
||||||
|
(let ((path (expand-file-name cmd dir)))
|
||||||
|
(if (file-exists-p path)
|
||||||
|
(throw 'loop path))))))
|
||||||
|
|
||||||
|
(defun ghc-uniq-lol (lol)
|
||||||
|
(let ((hash (make-hash-table :test 'equal))
|
||||||
|
ret)
|
||||||
|
(dolist (lst lol)
|
||||||
|
(dolist (key lst)
|
||||||
|
(puthash key key hash)))
|
||||||
|
(maphash (lambda (key val) (setq ret (cons key ret))) hash)
|
||||||
|
ret))
|
||||||
|
|
||||||
|
(defun ghc-read-lisp (func)
|
||||||
|
(with-temp-buffer
|
||||||
|
(funcall func)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(condition-case nil
|
||||||
|
(read (current-buffer))
|
||||||
|
(error ()))))
|
||||||
|
|
||||||
|
(provide 'ghc-func)
|
||||||
46
elisp/ghc.el
Normal file
46
elisp/ghc.el
Normal file
@ -0,0 +1,46 @@
|
|||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; ghc.el
|
||||||
|
;;;
|
||||||
|
|
||||||
|
;; Author: Kazu Yamamoto <Kazu@Mew.org>
|
||||||
|
;; Created: Sep 25, 2009
|
||||||
|
;; Revised:
|
||||||
|
|
||||||
|
;; Put the following code to your "~/.emacs".
|
||||||
|
;;
|
||||||
|
;; (autoload 'ghc-init "ghc" nil t)
|
||||||
|
;; (add-hook 'haskell-mode-hook (lambda () (ghc-init)))
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defvar ghc-version "0.1")
|
||||||
|
|
||||||
|
;; (require 'haskell-mode)
|
||||||
|
(require 'ghc-comp)
|
||||||
|
(require 'ghc-doc)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Customize Variables
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defvar ghc-completion-key "\e\t")
|
||||||
|
(defvar ghc-document-key "\e\C-d")
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;;
|
||||||
|
;;; Initializer
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(defvar ghc-initialized nil)
|
||||||
|
|
||||||
|
(defun ghc-init ()
|
||||||
|
(unless ghc-initialized
|
||||||
|
(define-key haskell-mode-map ghc-completion-key 'ghc-complete)
|
||||||
|
(define-key haskell-mode-map ghc-document-key 'ghc-browse-document)
|
||||||
|
(ghc-comp-init)
|
||||||
|
(setq ghc-initialized t)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
25
ghc-mod.cabal
Normal file
25
ghc-mod.cabal
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
-- -*- mode: Text; indent-tabs-mode: nil; -*-
|
||||||
|
Name: ghc-mod
|
||||||
|
Version: 0.1
|
||||||
|
Author: Kazu Yamamoto <kazu@Mew.org>
|
||||||
|
Maintainer: Kazu Yamamoto <kazu@Mew.org>
|
||||||
|
License: BSD3
|
||||||
|
Homepage: http://www.mew.org/~kazu/
|
||||||
|
Synopsis: Extracting names from modules
|
||||||
|
Description: "ghc-mod" lists up all installed modules
|
||||||
|
or extracts names of functions, classes,
|
||||||
|
and data declarations. "ghc-mod" is a
|
||||||
|
backend for completion on Emacs.
|
||||||
|
Category: Development
|
||||||
|
Cabal-Version: >= 1.2
|
||||||
|
Build-Type: Simple
|
||||||
|
Data-Dir: elisp
|
||||||
|
Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
|
||||||
|
Executable ghc-mod
|
||||||
|
Main-Is: GHCMod.hs
|
||||||
|
GHC-Options: -Wall
|
||||||
|
Build-Depends: base >= 4.0,
|
||||||
|
parsec >= 2.0.0.0,
|
||||||
|
process >= 1.0,
|
||||||
|
haskell-src-exts >= 1.0
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user