shit tons of autocompletion now work! (works? ugh grammar)

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": [
-        "<span style='color: red; font-style: italic;'>Failed to load interface for `Lkjadflkjad'</span>"
-       ],
-       "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": [
-        "<span style='color: red; font-style: italic;'>Not in scope: `abc'<br/>Perhaps you meant `abs' (imported from Prelude)</span>"
-       ],
-       "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",

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

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 

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",

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.