intero 0.1.9 → 0.1.10
raw patch · 7 files changed
+197/−57 lines, 7 files
Files
- CHANGELOG +5/−0
- README.md +3/−9
- elisp/intero.el +42/−13
- intero.cabal +1/−1
- src/GhciFind.hs +63/−6
- src/InteractiveUI.hs +22/−4
- src/test/Main.hs +61/−24
CHANGELOG view
@@ -1,3 +1,8 @@+0.1.10:+ * Completion for module's local imports and definitions (https://github.com/chrisdone/intero/issues/31)+ * Starting the REPL takes the targets chosen for the backend+ * Prompt displays interrobang for cuteness (https://github.com/chrisdone/intero/issues/40)+ 0.1.9: * Support GHC 8 * Fix completion before any module is loaded (https://github.com/chrisdone/intero/issues/34)
README.md view
@@ -2,8 +2,10 @@ Complete interactive development program for Haskell -## Supported GHCs+## Supported GHC versions +Intero been built and tested on the following GHC versions:+ * GHC 8.0.1 * GHC 7.10.3 * GHC 7.10.2@@ -57,11 +59,3 @@ To load up your stack project use: $ stack ghci --with-ghc intero--## Supported GHC versions--Intero been built and tested on the following GHC versions:--* GHC 7.8.4-* GHC 7.10.2-* GHC 7.10.3
elisp/intero.el view
@@ -348,9 +348,14 @@ (prefix (let ((prefix-info (intero-completions-grab-prefix))) (when prefix-info (cl-destructuring-bind- (_beg _end prefix _type) prefix-info+ (beg end prefix _type) prefix-info prefix))))- (candidates (intero-get-completions arg))))+ (candidates+ (let ((prefix-info (intero-completions-grab-prefix)))+ (when prefix-info+ (cl-destructuring-bind+ (beg end prefix _type) prefix-info+ (intero-get-completions beg end))))))) (defun intero-completions-grab-prefix (&optional minlen) "Grab prefix at point for possible completion."@@ -432,13 +437,15 @@ (package-name (intero-package-name)) (name (format "*intero:%s:%s:repl*" (file-name-nondirectory root)- package-name)))+ package-name))+ (backend-buffer (intero-buffer 'backend))) (if (get-buffer name) (get-buffer name) (with-current-buffer (get-buffer-create name) (cd root) (intero-repl-mode)+ (intero-repl-mode-start (buffer-local-value 'intero-targets backend-buffer)) (current-buffer))))) (define-derived-mode intero-repl-mode comint-mode "Intero-REPL"@@ -446,7 +453,11 @@ (when (and (not (eq major-mode 'fundamental-mode)) (eq this-command 'intero-repl-mode)) (error "You probably meant to run: M-x intero-repl"))- (set (make-local-variable 'comint-prompt-regexp) intero-prompt-regexp)+ (set (make-local-variable 'comint-prompt-regexp) intero-prompt-regexp))++(defun intero-repl-mode-start (targets)+ "Start the process for the repl buffer."+ (setq intero-targets targets) (let ((arguments (intero-make-options-list intero-targets))) (insert (propertize (format "Starting:\n stack ghci %s\n" (mapconcat #'identity arguments " "))@@ -466,7 +477,8 @@ (when (process-live-p process) (message "Started Intero process for REPL.")))))) -(font-lock-add-keywords+;; For live migration, remove later+(font-lock-remove-keywords 'intero-repl-mode '(("\\(\4\\)" (0 (prog1 ()@@ -474,6 +486,14 @@ (match-end 1) ?λ)))))) +(font-lock-add-keywords+ 'intero-repl-mode+ '(("\\(\4\\)"+ (0 (prog1 ()+ (compose-region (match-beginning 1)+ (match-end 1)+ ?‽))))))+ (define-key intero-repl-mode-map [remap move-beginning-of-line] 'intero-repl-beginning-of-line) (define-key intero-repl-mode-map [remap delete-backward-char] 'intero-repl-delete-backward-char) @@ -618,15 +638,24 @@ (1+ (current-column))) (buffer-substring-no-properties beg end))))) -(defun intero-get-completions (prefix)+(defun intero-get-completions (beg end) "Get completions for a PREFIX."- (mapcar #'read- (cdr (split-string- (intero-blocking-call- 'backend- (format ":complete repl %S" prefix))- "\n"- t))))+ (split-string+ (intero-blocking-call+ 'backend+ (format ":complete-at %S %d %d %d %d %S"+ (buffer-file-name)+ (save-excursion (goto-char beg)+ (line-number-at-pos))+ (save-excursion (goto-char beg)+ (1+ (current-column)))+ (save-excursion (goto-char end)+ (line-number-at-pos))+ (save-excursion (goto-char end)+ (1+ (current-column)))+ (buffer-substring-no-properties beg end)))+ "\n"+ t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Process communication
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.9+ 0.1.10 synopsis: Complete interactive development program for Haskell license:
src/GhciFind.hs view
@@ -6,15 +6,18 @@ -- | Find type/location information. module GhciFind- (findType,FindType(..),findLoc,findNameUses)+ (findType,FindType(..),findLoc,findNameUses,findCompletions) where +#if __GLASGOW_HASKELL__ >= 800 import Module+#endif import Control.Exception import Data.List import Data.Map (Map) import qualified Data.Map as M import Data.Maybe+import DynFlags import FastString import GHC import GhcMonad@@ -25,6 +28,58 @@ import System.Directory import Var +-- | Find completions for the sample, context given by the location.+findCompletions :: (GhcMonad m)+ => Map ModuleName ModInfo+ -> FilePath+ -> String+ -> Int+ -> Int+ -> Int+ -> Int+ -> m (Either String [String])+findCompletions infos fp sample sl sc el ec =+ do mname <- guessModule infos fp+ case mname of+ Nothing ->+ return (Left "Couldn't guess that module name. Does it exist?")+ Just name ->+ case M.lookup name infos of+ Nothing ->+ return (Left ("No module info for the current file! Try loading it?"))+ Just moduleInf ->+ do df <- getDynFlags+ let toplevelNames =+ fromMaybe [] (modInfoTopLevelScope (modinfoInfo moduleInf))+ filteredToplevels =+ filter (isPrefixOf sample)+ (map (showppr df) toplevelNames)+ localNames <- findLocalizedCompletions (modinfoSpans moduleInf) sample sl sc el ec+ return (Right (take 30 (nub (localNames ++ filteredToplevels))))++-- | Find completions within the local scope of a definition of a+-- module.+findLocalizedCompletions+ :: GhcMonad m+ => [SpanInfo]+ -> String+ -> Int+ -> Int+ -> Int+ -> Int+ -> m [String]+findLocalizedCompletions spans' prefix _sl _sc _el _ec =+ do df <- getDynFlags+ return (mapMaybe (complete df) spans')+ where complete+ :: DynFlags -> SpanInfo -> Maybe String+ complete df si =+ do var <- spaninfoVar si+ let str = showppr df var+ if isPrefixOf prefix str+ then Just str+ else Nothing+ -- | Find any uses of the given identifier in the codebase. findNameUses :: (GhcMonad m) => Map ModuleName ModInfo@@ -37,7 +92,6 @@ -> m (Either String [SrcSpan]) findNameUses infos fp string sl sc el ec = do mname <- guessModule infos fp- case mname of Nothing -> return (Left "Couldn't guess that module name. Does it exist?")@@ -268,10 +322,13 @@ -- | Try to resolve the type display from the given span. resolveSpanInfo :: [SpanInfo] -> Int -> Int -> Int -> Int -> Maybe SpanInfo resolveSpanInfo spanList spanSL spanSC spanEL spanEC =- find contains spanList- where contains (SpanInfo ancestorSL ancestorSC ancestorEL ancestorEC _ _) =- ((ancestorSL == spanSL && spanSC >= ancestorSC) || (ancestorSL < spanSL)) &&- ((ancestorEL == spanEL && spanEC <= ancestorEC) || (ancestorEL > spanEL))+ find (contains spanSL spanSC spanEL spanEC) spanList++-- | Does the 'SpanInfo' contain the location given by the Ints?+contains :: Int -> Int -> Int -> Int -> SpanInfo -> Bool+contains spanSL spanSC spanEL spanEC (SpanInfo ancestorSL ancestorSC ancestorEL ancestorEC _ _) =+ ((ancestorSL == spanSL && spanSC >= ancestorSC) || (ancestorSL < spanSL)) &&+ ((ancestorEL == spanEL && spanEC <= ancestorEC) || (ancestorEL > spanEL)) -- | Guess a module name from a file path. guessModule :: GhcMonad m
src/InteractiveUI.hs view
@@ -241,10 +241,11 @@ ("steplocal", keepGoing stepLocalCmd, completeIdentifier), ("stepmodule",keepGoing stepModuleCmd, completeIdentifier), ("type", keepGoing' typeOfExpr, completeExpression),- ("type-at", keepGoing' typeAt, completeExpression),- ("all-types", keepGoing' allTypes, completeExpression),- ("uses", keepGoing' findAllUses, completeExpression),- ("loc-at", keepGoing' locationAt, completeExpression),+ ("type-at", keepGoing' typeAt, noCompletion),+ ("all-types", keepGoing' allTypes, noCompletion),+ ("uses", keepGoing' findAllUses, noCompletion),+ ("loc-at", keepGoing' locationAt, noCompletion),+ ("complete-at", keepGoing' completeAt, noCompletion), ("trace", keepGoing traceCmd, completeExpression), ("undef", keepGoing undefineMacro, completeMacro), ("unset", keepGoing unsetOptions, completeSetOptions)@@ -1762,6 +1763,23 @@ ")-(" ++ show (srcSpanEndLine span') ++ "," ++ show (srcSpanEndCol span') ++ ")"++-----------------------------------------------------------------------------+-- :complete-at++completeAt :: String -> InputT GHCi ()+completeAt str =+ handleSourceError GHC.printException $+ case parseSpan str of+ Left err -> liftIO (putStr err)+ Right (fp,sl,sc,el,ec,sample) | not (null str) ->+ do infos <- fmap mod_infos (lift getGHCiState)+ result <- findCompletions infos fp sample sl sc el ec+ case result of+ Left err -> error err+ Right completions ->+ liftIO (mapM_ putStrLn completions)+ _ -> return () ----------------------------------------------------------------------------- -- Helpers for locationAt/typeAt
src/test/Main.hs view
@@ -38,10 +38,12 @@ describe "Arguments parser" (do issue ":type-at \"Foo Bar.hs\" 1 1 1 1" "https://github.com/chrisdone/intero/issues/25"- (typeAtFile "Foo Bar.hs"- "x = 'a'"- (1,1,1,1,"x")- "x :: Char\n")+ (atFile ":type-at"+ "Foo Bar.hs"+ "x = 'a'"+ (1,1,1,1,"x")+ id+ "x :: Char\n") issue ":type-at" "https://github.com/chrisdone/intero/issues/28" (eval ":type-at"@@ -229,14 +231,43 @@ -- | Test interactive completions. completion :: Spec completion =- describe "Complete basic Prelude identifiers"- (issue ":complete repl \"put\""- "https://github.com/chrisdone/intero/issues/34"- (eval ":complete repl \"put\""- (unlines ["3 3 \"\""- ,"\"putChar\""- ,"\"putStr\""- ,"\"putStrLn\""])))+ do describe "Complete basic Prelude identifiers"+ (issue ":complete repl \"put\""+ "https://github.com/chrisdone/intero/issues/34"+ (eval ":complete repl \"put\""+ (unlines ["3 3 \"\""+ ,"\"putChar\""+ ,"\"putStr\""+ ,"\"putStrLn\""])))+ describe "Completion in module context"+ (do it ":complete-at for put*"+ (atFile ":complete-at"+ "X.hs"+ "module X () where\nx = undefined"+ (4,5,0,0,"put")+ lines+ ["putChar","putStr","putStrLn"])+ it ":complete-at for locally imported"+ (atFile ":complete-at"+ "X.hs"+ "module X () where\nimport Data.List\nx = undefined"+ (3,5,0,0,"sor")+ (take 2 . lines)+ ["sort","sortBy"])+ it ":complete-at for module-locally defined"+ (atFile ":complete-at"+ "X.hs"+ "module X () where\nx = undefined\nmodlocal = ()"+ (2,5,0,0,"modl")+ lines+ ["modlocal"])+ it ":complete-at for definition-locally defined"+ (atFile ":complete-at"+ "X.hs"+ "module X () where\nx = undefined where locally = let p = 123 in p"+ (2,5,0,0,"loc")+ lines+ ["locally"])) -------------------------------------------------------------------------------- -- Combinators for running and interacting with intero@@ -259,7 +290,8 @@ -- | Find use-sites for the given place. uses- :: String -> (Int,Int,Int,Int,String) -> (String -> String) -> String -> Expectation+ :: (Eq a,Show a)+ => String -> (Int,Int,Int,Int,String) -> (String -> a) -> a -> Expectation uses file (line,col,line',col',name) preprocess expected = do result <- withIntero@@ -272,24 +304,29 @@ shouldBe (preprocess result) expected -- | Test the type at the given place.-typeAt- :: String -> (Int,Int,Int,Int,String) -> String -> Expectation-typeAt = do typeAtFile "X.hs"+typeAt :: String+ -> (Int,Int,Int,Int,String)+ -> String+ -> Expectation+typeAt a b c = do atFile ":type-at" "X.hs" a b id c -- | Test the type at the given place (with the given filename).-typeAtFile :: String- -> String- -> (Int,Int,Int,Int,String)- -> String- -> Expectation-typeAtFile fname file (line,col,line',col',name) expected =+atFile :: (Eq a,Show a)+ => String+ -> String+ -> String+ -> (Int,Int,Int,Int,String)+ -> (String -> a)+ -> a+ -> Expectation+atFile cmd fname file (line,col,line',col',name) preprocess expected = do result <- withIntero [] (\dir repl -> do writeFile (dir ++ "/" ++ fname) file _ <- repl (":l " ++ show fname)- repl (":type-at " +++ repl (cmd ++ " " ++ (if any isSpace fname then show fname else fname) ++@@ -298,7 +335,7 @@ (if null name then "" else " " ++ show name)))- shouldBe result expected+ shouldBe (preprocess result) expected -- | Make a quick interaction with intero. eval :: String -- ^ Input.