diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/elisp/intero.el b/elisp/intero.el --- a/elisp/intero.el +++ b/elisp/intero.el @@ -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 diff --git a/intero.cabal b/intero.cabal --- a/intero.cabal +++ b/intero.cabal @@ -1,7 +1,7 @@ name: intero version: - 0.1.9 + 0.1.10 synopsis: Complete interactive development program for Haskell license: diff --git a/src/GhciFind.hs b/src/GhciFind.hs --- a/src/GhciFind.hs +++ b/src/GhciFind.hs @@ -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 diff --git a/src/InteractiveUI.hs b/src/InteractiveUI.hs --- a/src/InteractiveUI.hs +++ b/src/InteractiveUI.hs @@ -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 diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -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.