Skip to content

Commit 78e4c95

Browse files
paf31paf31
committed
Merge pull request purescript#800 from vkorablin/completion
More completion improvements for PSCI
2 parents 01e1dad + c542b4f commit 78e4c95

3 files changed

Lines changed: 79 additions & 45 deletions

File tree

‎psci/Main.hs‎

Lines changed: 73 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -185,27 +185,28 @@ quitMessage = "See ya!"
185185

186186
-- Haskeline completions
187187

188-
data CompletionContext = Command String | FilePath | Module | Identifier | Fixed [String] | Multiple [CompletionContext]
188+
data CompletionContext = Command String | FilePath String | Module | Identifier
189+
| Type | Fixed [String] | Multiple [CompletionContext]
189190
deriving (Show)
190191

191192
-- |
192193
-- Decide what kind of completion we need based on input.
193-
completionContext :: String -> Maybe CompletionContext
194-
completionContext cmd@"" = Just $ Multiple [Command cmd, Identifier]
195-
completionContext cmd@(':' : _ )
194+
completionContext :: String -> String -> Maybe CompletionContext
195+
completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]
196+
completionContext cmd@(':' : _ ) _
196197
| cmd `elem` C.commands || cmd == ":" = Just $ Command cmd
197-
completionContext (':' : c : _) = case c of
198+
completionContext (':' : c : _) word = case c of
198199
'i' -> Just Module
199200
'b' -> Just Module
200-
'm' -> Just FilePath
201+
'm' -> Just $ FilePath word
201202
'q' -> Nothing
202203
'r' -> Nothing
203204
'?' -> Nothing
204205
's' -> Just $ Fixed ["import", "loaded"]
205206
't' -> Just Identifier
206-
'k' -> Just Identifier
207+
'k' -> Just Type
207208
_ -> Nothing
208-
completionContext _ = Just Identifier
209+
completionContext _ _ = Just Identifier
209210

210211
-- |
211212
-- Loads module, function, and file completions.
@@ -215,53 +216,84 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
215216
where
216217
findCompletions :: String -> String -> StateT PSCiState IO [Completion]
217218
findCompletions prev word = do
218-
let ctx = completionContext $ (dropWhile isSpace (reverse prev)) ++ word
219+
let ctx = completionContext ((dropWhile isSpace (reverse prev)) ++ word) word
219220
completions <- case ctx of
220221
Nothing -> return []
221222
(Just c) -> (mapMaybe $ either (\cand -> if word `isPrefixOf` cand
222223
then Just $ simpleCompletion cand
223224
else Nothing) Just)
224-
<$> getCompletion c word
225+
<$> getCompletion c
225226
return $ sortBy sorter completions
226227

227-
getCompletion :: CompletionContext -> String -> StateT PSCiState IO [Either String Completion]
228-
getCompletion (Command s) _ = return $ (map Left) $ nub $ filter (isPrefixOf s) C.commands
229-
getCompletion FilePath f = (map Right) <$> listFiles f
230-
getCompletion Module _ = (map Left) <$> getModuleNames
231-
getCompletion Identifier _ = (map Left) <$> getIdentNames
232-
getCompletion (Fixed list) _ = return $ (map Left) list
233-
getCompletion (Multiple contexts) f = concat <$> mapM (flip getCompletion $ f) contexts
228+
getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]
229+
getCompletion (Command s) = return $ (map Left) $ nub $ filter (isPrefixOf s) C.commands
230+
getCompletion (FilePath f) = (map Right) <$> listFiles f
231+
getCompletion Module = (map Left) <$> getModuleNames
232+
getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)
233+
getCompletion Type = (map Left) <$> getTypeNames
234+
getCompletion (Fixed list) = return $ (map Left) list
235+
getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts
234236

235237
getLoadedModules :: StateT PSCiState IO [P.Module]
236238
getLoadedModules = map snd . psciLoadedModules <$> get
237239

238240
getModuleNames :: StateT PSCiState IO [String]
239241
getModuleNames = moduleNames <$> getLoadedModules
240242

243+
mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [a]) -> StateT PSCiState IO [String]
244+
mapLoadedModulesAndQualify f = do
245+
ms <- getLoadedModules
246+
q <- sequence [qualifyIfNeeded m (f m) | m <- ms]
247+
return $ concat q
248+
241249
getIdentNames :: StateT PSCiState IO [String]
242-
getIdentNames = identNames <$> getLoadedModules
243-
244-
getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
245-
getDeclName exts (P.ValueDeclaration ident _ _ _) | isExported ident exts = Just ident
246-
getDeclName exts (P.ExternDeclaration _ ident _ _) | isExported ident exts = Just ident
247-
getDeclName exts (P.PositionedDeclaration _ d) = getDeclName exts d
248-
getDeclName _ _ = Nothing
249-
250-
isExported :: N.Ident -> Maybe [P.DeclarationRef] -> Bool
251-
isExported ident = maybe True (any exports)
252-
where
253-
exports :: P.DeclarationRef -> Bool
254-
exports (P.ValueRef ident') = ident == ident'
255-
exports (P.PositionedDeclarationRef _ r) = exports r
256-
exports _ = False
257-
258-
identNames :: [P.Module] -> [String]
259-
identNames ms = nub [ show qual
260-
| P.Module moduleName ds exts <- ms
261-
, ident <- mapMaybe (getDeclName exts) ds
262-
, qual <- [ P.Qualified Nothing ident
263-
, P.Qualified (Just moduleName) ident]
264-
]
250+
getIdentNames = mapLoadedModulesAndQualify identNames
251+
252+
getDctorNames :: StateT PSCiState IO [String]
253+
getDctorNames = mapLoadedModulesAndQualify dctorNames
254+
255+
getTypeNames :: StateT PSCiState IO [String]
256+
getTypeNames = mapLoadedModulesAndQualify typeDecls
257+
258+
qualifyIfNeeded :: (Show a) => P.Module -> [a] -> StateT PSCiState IO [String]
259+
qualifyIfNeeded m decls = do
260+
let name = P.getModuleName m
261+
imported <- psciImportedModuleNames <$> get
262+
let qualified = map (P.Qualified $ Just name) decls
263+
if name `elem` imported then
264+
return $ map show $ qualified ++ (map (P.Qualified Nothing) decls)
265+
else
266+
return $ map show qualified
267+
268+
typeDecls :: P.Module -> [N.ProperName]
269+
typeDecls m = mapMaybe getTypeName $ filter P.isDataDecl (P.exportedDeclarations m)
270+
where getTypeName :: P.Declaration -> Maybe N.ProperName
271+
getTypeName (P.TypeSynonymDeclaration name _ _) = Just name
272+
getTypeName (P.DataDeclaration _ name _ _) = Just name
273+
getTypeName (P.PositionedDeclaration _ d) = getTypeName d
274+
getTypeName _ = Nothing
275+
276+
identNames :: P.Module -> [N.Ident]
277+
identNames (P.Module _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) ds ]
278+
where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
279+
getDeclName exts decl@(P.ValueDeclaration ident _ _ _) | P.isExported exts decl = Just ident
280+
getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident
281+
getDeclName exts (P.PositionedDeclaration _ d) = getDeclName exts d
282+
getDeclName _ _ = Nothing
283+
284+
dctorNames :: P.Module -> [N.ProperName]
285+
dctorNames m = nub $ concat $ map (P.exportedDctors m) dnames
286+
where getDataDeclName :: P.Declaration -> Maybe N.ProperName
287+
getDataDeclName (P.DataDeclaration _ name _ _) = Just name
288+
getDataDeclName (P.PositionedDeclaration _ d) = getDataDeclName d
289+
getDataDeclName _ = Nothing
290+
291+
dnames :: [N.ProperName]
292+
dnames = (mapMaybe getDataDeclName onlyDataDecls)
293+
294+
onlyDataDecls :: [P.Declaration]
295+
onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
296+
265297
moduleNames :: [P.Module] -> [String]
266298
moduleNames ms = nub [show moduleName | P.Module moduleName _ _ <- ms]
267299

@@ -601,7 +633,6 @@ main = execParser opts >>= loop
601633
infoModList = fullDesc <> headerInfo <> footerInfo
602634
headerInfo = header "psci - Interactive mode for PureScript"
603635
footerInfo = footer $ "psci " ++ showVersion Paths.version
604-
636+
605637
version :: Parser (a -> a)
606638
version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
607-

‎src/Language/PureScript/AST/Declarations.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,10 @@ import Language.PureScript.Environment
3434
--
3535
data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
3636

37+
-- | Return a module's name.
38+
getModuleName :: Module -> ModuleName
39+
getModuleName (Module name _ _) = name
40+
3741
-- |
3842
-- Test if a declaration is exported, given a module's export list.
3943
--
@@ -44,6 +48,7 @@ isExported exps (PositionedDeclaration _ d) = isExported exps d
4448
isExported (Just exps) decl = any (matches decl) exps
4549
where
4650
matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
51+
matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
4752
matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
4853
matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
4954
matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
@@ -77,6 +82,7 @@ exportedDctors (Module _ decls exps) ident =
7782
where
7883
dctors = concatMap getDctors decls
7984
getDctors (DataDeclaration _ _ _ ctors) = map fst ctors
85+
getDctors (PositionedDeclaration _ d) = getDctors d
8086
getDctors _ = []
8187

8288
-- |

‎src/Language/PureScript/ModuleDependencies.hs‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -64,9 +64,6 @@ usedModules = let (f, _, _, _, _) = everythingOnValues (++) forDecls forValues (
6464
forTypes (ConstrainedType cs _) = mapMaybe (\(Qualified mn _, _) -> mn) cs
6565
forTypes _ = []
6666

67-
getModuleName :: Module -> ModuleName
68-
getModuleName (Module mn _ _) = mn
69-
7067
-- |
7168
-- Convert a strongly connected component of the module graph to a module
7269
--

0 commit comments

Comments
 (0)