From d0f6ad7f4cce2121eadf55d1875bd901760e6adb Mon Sep 17 00:00:00 2001 From: Andrew Gibiansky Date: Tue, 17 Dec 2013 21:47:59 -0800 Subject: [PATCH] shit tons of autocompletion now work! (works? ugh grammar) --- Haskell-Notebook.ipynb | 66 ++++-------------- Hspec.hs | 76 ++++++++++++++++++++- IHaskell/Eval/Completion.hs | 131 ++++++++++++++++++++++++++++-------- IHaskell/Eval/Evaluate.hs | 4 +- Main.hs | 10 +-- 5 files changed, 199 insertions(+), 88 deletions(-) diff --git a/Haskell-Notebook.ipynb b/Haskell-Notebook.ipynb index 632d0af7..f4d609da 100644 --- a/Haskell-Notebook.ipynb +++ b/Haskell-Notebook.ipynb @@ -95,56 +95,29 @@ "cell_type": "code", "collapsed": false, "input": [ - "import Lkjadflkjad\n", - "import Alksjdfljksd" + "import Prel" ], "language": "python", "metadata": {}, - "outputs": [ - { - "html": [ - "Failed to load interface for `Lkjadflkjad'" - ], - "metadata": {}, - "output_type": "display_data", - "text": [ - "Failed to load interface for `Lkjadflkjad'\n", - "Use -v to see a list of the files searched for." - ] - } - ], - "prompt_number": 4 + "outputs": [], + "prompt_number": 1 }, { "cell_type": "code", "collapsed": false, "input": [ - "abc\n", - "adsf" + "import Prelude" ], "language": "python", "metadata": {}, - "outputs": [ - { - "html": [ - "Not in scope: `abc'
Perhaps you meant `abs' (imported from Prelude)" - ], - "metadata": {}, - "output_type": "display_data", - "text": [ - "Not in scope: `abc'\n", - "Perhaps you meant `abs' (imported from Prelude)" - ] - } - ], - "prompt_number": 5 + "outputs": [], + "prompt_number": 1 }, { "cell_type": "code", "collapsed": false, "input": [ - "doubleIt :: Int -> String\n", - "doubleIt = show" + "ma" ], "language": "python", "metadata": {}, @@ -371,33 +344,22 @@ "cell_type": "code", "collapsed": false, "input": [ - "let x = 3\n", - "let y =10\n", - "let z = 100\n", - "print 3\n", - "import Control.Monad" + "m" ], "language": "python", "metadata": {}, - "outputs": [ - { - "metadata": {}, - "output_type": "display_data", - "text": [ - "3" - ] - } - ], - "prompt_number": 7 + "outputs": [], + "prompt_number": 2 }, { "cell_type": "code", "collapsed": false, "input": [ - "import Text.Blaze.Html4.Strict hiding (map)\n", + "import Prelude hiding (div, id)\n", + "import Text.Blaze.Html4.Strict hiding (map, style)\n", "import Text.Blaze.Html4.Strict.Attributes\n", "import Control.Monad\n", - "div ! Text.Blaze.Html4.Strict.Attributes.style \"color: red\" $ do\n", + "div ! style \"color: red\" $ do\n", " p \"This is an example of BlazeMarkup syntax.\"\n", " p \"Hello\"\n", " b \"Hello\"\n", @@ -439,7 +401,7 @@ ] } ], - "prompt_number": 40 + "prompt_number": 3 }, { "cell_type": "code", diff --git a/Hspec.hs b/Hspec.hs index fe2fdac0..45aef5f4 100644 --- a/Hspec.hs +++ b/Hspec.hs @@ -6,12 +6,13 @@ import Control.Monad import Data.List import System.Directory import Data.String.Here -import Data.String.Utils (strip) +import Data.String.Utils (strip, replace) import IHaskell.Eval.Parser import IHaskell.Types import IHaskell.IPython import IHaskell.Eval.Evaluate +import IHaskell.Eval.Completion import Test.Hspec import Test.Hspec.HUnit @@ -56,13 +57,86 @@ becomes string expected = do Just (Display PlainText str) -> str `shouldBe` expected Nothing -> expectationFailure $ "No plain-text output in " ++ show result +completes string expected = completionTarget newString cursorloc `shouldBe` expected + where (newString, cursorloc) = case findIndex (=='!') string of + Nothing -> error "Expected cursor written as '!'." + Just idx -> (replace "!" "" string, idx) +completionHas string expected = do + (matched, completions) <- doGhc $ do + initCompleter + complete newString cursorloc + let existsInCompletion = (`elem` completions) + unmatched = filter (not . existsInCompletion) expected + unmatched `shouldBe` [] + where (newString, cursorloc) = case findIndex (=='!') string of + Nothing -> error "Expected cursor written as '!'." + Just idx -> (replace "!" "" string, idx) + +initCompleter :: GhcMonad m => m () +initCompleter = do + flags <- getSessionDynFlags + setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory } + + -- Import modules. + imports <- mapM parseImportDecl ["import Prelude", + "import qualified Control.Monad", + "import qualified Data.List as List", + "import Data.Maybe as Maybe"] + setContext $ map IIDecl imports main :: IO () main = hspec $ do parserTests ipythonTests evalTests + completionTests + +completionTests = do + describe "Completion" $ do + it "correctly gets the completion identifier without dots" $ do + "hello!" `completes` ["hello"] + "hello aa!bb goodbye" `completes` ["aa"] + "hello aabb! goodbye" `completes` ["aabb"] + "aacc! goodbye" `completes` ["aacc"] + "hello !aabb goodbye" `completes` [] + "!aabb goodbye" `completes` [] + + it "correctly gets the completion identifier with dots" $ do + "hello test.aa!bb goodbye" `completes` ["test", "aa"] + "Test.!" `completes` ["Test", ""] + "Test.Thing!" `completes` ["Test", "Thing"] + "Test.Thing.!" `completes` ["Test", "Thing", ""] + "Test.Thing.!nope" `completes` ["Test", "Thing", ""] + + it "correctly gets the completion type" $ do + completionType "import Data." ["Data", ""] `shouldBe` ModuleName "Data" "" + completionType "import Prel" ["Prel"] `shouldBe` ModuleName "" "Prel" + completionType "import Data.Bloop.M" ["Data", "Bloop", "M"] `shouldBe` ModuleName "Data.Bloop" "M" + completionType " import A." ["A", ""] `shouldBe` ModuleName "A" "" + completionType "import a.x" ["a", "x"] `shouldBe` Identifier "x" + completionType "A.x" ["A", "x"] `shouldBe` Qualified "A" "x" + completionType "a.x" ["a", "x"] `shouldBe` Identifier "x" + completionType "pri" ["pri"] `shouldBe` Identifier "pri" + + it "properly completes identifiers" $ do + "pri!" `completionHas` ["print"] + "ma!" `completionHas` ["map"] + "hello ma!" `completionHas` ["map"] + "print $ catMa!" `completionHas` ["catMaybes"] + + it "properly completes qualified identifiers" $ do + "Control.Monad.liftM!" `completionHas` [ "Control.Monad.liftM" + , "Control.Monad.liftM2" + , "Control.Monad.liftM5"] + "print $ List.intercal!" `completionHas` ["List.intercalate"] + "print $ Data.Maybe.cat!" `completionHas` ["Data.Maybe.catMaybes"] + "print $ Maybe.catM!" `completionHas` ["Maybe.catMaybes"] + + it "properly completes imports" $ do + "import Data.!" `completionHas` ["Data.Maybe", "Data.List"] + "import Data.M!" `completionHas` ["Data.Maybe"] + "import Prel!" `completionHas` ["Prelude"] evalTests = do describe "Code Evaluation" $ do diff --git a/IHaskell/Eval/Completion.hs b/IHaskell/Eval/Completion.hs index 681277c2..3c3dc1a6 100644 --- a/IHaskell/Eval/Completion.hs +++ b/IHaskell/Eval/Completion.hs @@ -15,56 +15,129 @@ names should not be confused by the third option. -} -module IHaskell.Eval.Completion (makeCompletions) where +module IHaskell.Eval.Completion (complete, completionTarget, completionType, CompletionType(..)) where import Prelude -import Data.List (find, isPrefixOf, nub) -import qualified GHC +import Data.List (find, isPrefixOf, nub, findIndex, intercalate) +import GHC +import GhcMonad +import PackageConfig import Outputable (showPpr) import Data.Char -import Data.ByteString.UTF8 hiding (drop) +import Data.ByteString.UTF8 hiding (drop, take) import Data.List.Split import Data.List.Split.Internals +import Data.String.Utils (strip, startswith, replace) import Data.Maybe import IHaskell.Types import Control.Applicative ((<$>)) +import Debug.Trace -makeCompletions :: GHC.GhcMonad m => MessageHeader -> Message -> m Message -makeCompletions replyHeader (CompleteRequest _ _ line pos) = do - names <- GHC.getRdrNamesInScope - flags <- GHC.getProgramDynFlags +data CompletionType + = Empty + | Identifier String + | Qualified String String + | ModuleName String String + deriving (Show, Eq) - let maybeCand = getWordAt (toString line) pos - options = - case maybeCand of - Nothing -> [] - Just candidate -> nub $ filter (candidate `isPrefixOf`) $ map (showPpr flags) names - matched_text = fromString $ fromMaybe "" maybeCand +complete :: GHC.GhcMonad m => String -> Int -> m (String, [String]) +complete line pos = do + flags <- getSessionDynFlags + rdrNames <- map (showPpr flags) <$> getRdrNamesInScope + scopeNames <- nub <$> map (showPpr flags) <$> getNamesInScope + let isQualified = ('.' `elem`) + unqualNames = nub $ filter (not . isQualified) rdrNames + qualNames = nub $ scopeNames ++ filter isQualified rdrNames - return $ CompleteReply replyHeader (map fromString options) matched_text line True + let Just db = pkgDatabase flags + getNames = map moduleNameString . exposedModules + moduleNames = nub $ concat $ map getNames db + + let target = completionTarget line pos + matchedText = intercalate "." target + + options <- + case completionType line target of + Empty -> return [] + Identifier candidate -> + return $ filter (candidate `isPrefixOf`) unqualNames + Qualified moduleName candidate -> do + trueName <- getTrueModuleName moduleName + let prefix = intercalate "." [trueName, candidate] + completions = filter (prefix `isPrefixOf`) qualNames + falsifyName = replace trueName moduleName + return $ map falsifyName completions + ModuleName previous candidate -> do + let prefix = if null previous + then candidate + else intercalate "." [previous, candidate] + return $ filter (prefix `isPrefixOf`) moduleNames + + return (matchedText, options) + +getTrueModuleName :: GhcMonad m => String -> m String +getTrueModuleName name = do + -- Only use the things that were actually imported + let onlyImportDecl (IIDecl decl) = Just decl + onlyImportDecl _ = Nothing + + -- Get all imports that we use. + imports <- catMaybes <$> map onlyImportDecl <$> getContext + + -- Find the ones that have a qualified name attached. + -- If this name isn't one of them, it already is the true name. + flags <- getSessionDynFlags + let qualifiedImports = filter (isJust . ideclAs) imports + hasName imp = name == (showPpr flags . fromJust . ideclAs) imp + case find hasName qualifiedImports of + Nothing -> return name + Just trueImp -> return $ showPpr flags $ unLoc $ ideclName trueImp + +completionType :: String -> [String] -> CompletionType +completionType line [] = Empty +completionType line target = + if startswith "import" (strip line) && isModName + then ModuleName dotted candidate + else + if isModName && (not . null . init) target + then Qualified dotted candidate + else Identifier candidate + where + dotted = dots target + candidate = last target + dots = intercalate "." . init + isModName = all isCapitalized (init target) + isCapitalized = isUpper . head -- | Get the word under a given cursor location. -getWordAt :: String -> Int -> Maybe String -getWordAt xs n = map fst <$> find (elem n . map snd) (split splitter $ zip xs [1 .. ]) +completionTarget :: String -> Int -> [String] +completionTarget code cursor = expandCompletionPiece pieceToComplete where + pieceToComplete = map fst <$> find (elem cursor . map snd) pieces + pieces = splitAlongCursor $ split splitter $ zip code [1 .. ] splitter = defaultSplitter { -- Split using only the characters, which are the first elements of -- the (char, index) tuple - delimiter = Delimiter [isDelim . fst], - -- Condense multiple delimiters into one - condensePolicy = Condense + delimiter = Delimiter [uncurry isDelim], + -- Condense multiple delimiters into one and then drop them. + condensePolicy = Condense, + delimPolicy = Drop } - isDelim char = - case drop (max 0 (n - 1)) xs of - x:_ -> (char `elem` neverIdent) || if isSymbol x - then isAlpha char - else isSymbol char - _ -> char `elem` neverIdent + isDelim char idx = char `elem` neverIdent || isSymbol char - -- These are never part of an identifier, except for the dot. - -- Qualified names are tricky! - neverIdent = " \t(),{}[]\\'\"`." + splitAlongCursor :: [[(Char, Int)]] -> [[(Char, Int)]] + splitAlongCursor [] = [] + splitAlongCursor (x:xs) = + case findIndex (== cursor) $ map snd x of + Nothing -> x:splitAlongCursor xs + Just idx -> take (idx + 1) x:drop (idx + 1) x:splitAlongCursor xs + + -- These are never part of an identifier. + neverIdent = " \n\t(),{}[]\\'\"`" + + expandCompletionPiece Nothing = [] + expandCompletionPiece (Just str) = splitOn "." str diff --git a/IHaskell/Eval/Evaluate.hs b/IHaskell/Eval/Evaluate.hs index 90ad7bca..471ab48c 100644 --- a/IHaskell/Eval/Evaluate.hs +++ b/IHaskell/Eval/Evaluate.hs @@ -5,7 +5,7 @@ This module exports all functions used for evaluation of IHaskell input. -} module IHaskell.Eval.Evaluate ( - interpret, evaluate, Interpreter, liftIO, typeCleaner + interpret, evaluate, Interpreter, liftIO, typeCleaner, globalImports ) where import ClassyPrelude hiding (liftIO, hGetContents) @@ -50,7 +50,7 @@ import IHaskell.Display data ErrorOccurred = Success | Failure deriving Show debug :: Bool -debug = True +debug = False ignoreTypePrefixes :: [String] ignoreTypePrefixes = ["GHC.Types", "GHC.Base", "GHC.Show", "System.IO", diff --git a/Main.hs b/Main.hs index 0e8d0f2a..856f20b0 100644 --- a/Main.hs +++ b/Main.hs @@ -17,7 +17,7 @@ import IHaskell.Types import IHaskell.ZeroMQ import qualified IHaskell.Message.UUID as UUID import IHaskell.Eval.Evaluate -import IHaskell.Eval.Completion (makeCompletions) +import IHaskell.Eval.Completion (complete) import IHaskell.Eval.Info import qualified Data.ByteString.Char8 as Chars import IHaskell.IPython @@ -170,9 +170,11 @@ replyTo interface ExecuteRequest{ getCode = code } replyHeader state = do }) -replyTo _ creq@CompleteRequest{} replyHeader state = do - cr <- makeCompletions replyHeader creq - return (state, cr) +replyTo _ req@CompleteRequest{} replyHeader state = do + (matchedText, completions) <- complete (Chars.unpack $ getCodeLine req) (getCursorPos req) + + let reply = CompleteReply replyHeader (map Chars.pack completions) (Chars.pack matchedText) (getCodeLine req) True + return (state, reply) -- | Reply to the object_info_request message. Given an object name, return -- | the associated type calculated by GHC.