├── .ghci ├── .gitignore ├── CHANGELOG ├── LICENSE ├── README.md ├── Setup.hs ├── exe ├── Halberd.hs └── Halberd │ └── UI.hs ├── halberd.cabal ├── src ├── Data │ └── Tuple │ │ └── Utils.hs ├── Halberd │ ├── ChosenImports.hs │ ├── CollectNames.hs │ ├── LookupTable.hs │ ├── Suggestions.hs │ └── Types.hs └── Language │ └── Haskell │ └── Exts │ └── Utils.hs ├── test.hs └── tests ├── Runner.hs └── input ├── ResolveMultiple.hs ├── ResolveMultipleDifferentOrder.hs ├── ResolveSingle.hs └── Unbound.hs /.ghci: -------------------------------------------------------------------------------- 1 | :set -Wall -isrc 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | 0.1.2.9 2 | * Allow haskell-src-exts 1.16. 3 | 4 | 0.1.2.8 5 | * Allow haskell-names 0.4. 6 | 7 | 0.1.2.7 8 | * Fix missing cases when using haskell-src-exts 1.15. 9 | * Allow mtl 2.2. 10 | 11 | 0.1.2.6 12 | * Allow Cabal 1.20.*. 13 | 14 | 0.1.2.5 15 | * Allow haskell-src-exts 1.15. 16 | 17 | 0.1.2.4 18 | * Allow base 4.7 (GHC 7.8). 19 | 20 | 0.1.2.3 21 | * Allow haskell-names 0.3. 22 | 23 | 0.1.2.2: 24 | * Remove hardcoded path from source. 25 | 26 | 0.1.2.1: 27 | * Relax Cabal constraint. 28 | * Remove halberd constraint. It made the last version unbuildable. 29 | 30 | 0.1.2: 31 | * Actual order independent choosing. 32 | * Added test cases. 33 | * Refactored code. 34 | 35 | 0.1.1: 36 | * Include needed modules. 37 | * Smarter, order-independent auto-choosing. 38 | 39 | 0.1: 40 | * Initial release 41 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Erik Hesselink 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Erik Hesselink nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Halberd: generating imports 2 | ========== 3 | 4 | Halberd is a tool to help you add missing imports to your Haskell source files. With it, you can write your source without imports, call Halberd, and just paste in the import lines. 5 | 6 | Currently, it tries to automatically choose an import if there is a single sensible option. If it can't, it will prompt you with a simple menu. After running, it prints the imports, which you need to copy manually. Editor integration is planned. 7 | 8 | The imports generated are either qualified, if the unbound function looks like `M.lookup`, or explicit, if it looks like `void`. 9 | 10 | Example 11 | ---------- 12 | 13 | As an example, say you have written the following (nonsensical and type incorrect) Haskell file called `test.hs`: 14 | 15 | ``` haskell 16 | main :: IO Int8 17 | main = do 18 | forM_ [1,2] $ \x -> print $ M.lookup x table 19 | liftM id $ return $ headNote "Impossible" [10] 20 | 21 | table :: M.Map String Int8 22 | table = M.fromList [("Odeca", 1), ("Hackathon",2)] 23 | ``` 24 | 25 | You can run Halberd on this by running `halberd test.hs`. It will prompt you with three questions: 26 | 27 | ``` 28 | forM_: 29 | 1) Control.Monad 30 | 2) Data.Foldable 31 | 32 | M.lookup: 33 | 1) Data.List 34 | 2) GHC.List 35 | 3) Prelude 36 | 4) Data.IntMap 37 | 5) Data.IntMap.Lazy 38 | 6) Data.IntMap.Strict 39 | 7) Data.Map 40 | 8) Data.Map.Lazy 41 | 9) Data.Map.Strict 42 | 43 | Int8: 44 | 1) Data.Int 45 | 2) Foreign 46 | 3) Foreign.Safe 47 | 4) GHC.Int 48 | ``` 49 | 50 | After making the choices by typing `1`, `7` and `1`, it generated the folling output: 51 | 52 | ``` haskell 53 | ------------- Could not find import for ------------- 54 | - headNote 55 | 56 | -------- Insert these imports into your file -------- 57 | 58 | import qualified Data.Map as M 59 | import Control.Monad ( forM_, liftM ) 60 | import Data.Int ( Int8 ) 61 | ``` 62 | 63 | As you can see, it didn't ask questions about `M.Map`, `M.fromList`, `liftM` and the second usage of `Int8`. It figured these out either because of previous choices, or because there was only a single option. 64 | 65 | Installation 66 | ---------- 67 | 68 | Halberd uses the Haskell Suite packages (`haskell-src-exts`, `haskell-packages` and `haskell-names`) for parsing, name resolution and finding exposed identifiers of packages. While these can be installed from hackage, generating databases of names for new packages currently needs a custom version of the `cabal install` executable. See the [documentation for haskell-names](https://github.com/haskell-suite/haskell-names) for more details. 69 | 70 | To install Halberd, just do 71 | 72 | ``` 73 | cabal install halberd 74 | ``` 75 | 76 | This will give you a `halberd` executable that takes a single argument, the file to generate imports for. By default, it only draws names from `base`. If you want to add more names, use `hs-gen-iface` from the `haskell-names` package. 77 | 78 | Improvements 79 | ---------- 80 | 81 | Halberd is still in an unfinished state. Some planned improvements are: 82 | 83 | * Smarter automatic choices. 84 | * Editor integration. 85 | * Easier installation of name databases (`haskell-names`). 86 | * Integration with existing imports. 87 | * Better choice UI. 88 | * Choices based on type information (`haskell-type-exts`). 89 | 90 | Contributions are welcome! 91 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /exe/Halberd.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Applicative 4 | import Control.Monad hiding (forM_) 5 | import Data.Foldable (forM_) 6 | import Data.List 7 | import Data.Proxy 8 | import Distribution.HaskellSuite 9 | import Distribution.Simple.Compiler 10 | import Language.Haskell.Exts.Annotated 11 | import Language.Haskell.Names.Interfaces 12 | import System.Environment 13 | import System.Exit 14 | 15 | import Halberd.ChosenImports 16 | import Halberd.Suggestions 17 | import Halberd.UI 18 | 19 | main :: IO () 20 | main = 21 | do args <- getArgs 22 | case args of 23 | [] -> do 24 | putStrLn "Usage: halberd " 25 | exitFailure 26 | (file:_) -> do 27 | (ParseOk module_) <- parseFile file 28 | pkgs <- concat <$> mapM (getInstalledPackages (Proxy :: Proxy NamesDB)) 29 | [UserPackageDB, GlobalPackageDB] 30 | allSuggestions <- evalModuleT (suggestedImports module_) pkgs suffix readInterface 31 | 32 | let (suggestions, noSuggestions) = partition (not . null . snd) allSuggestions 33 | 34 | chosenImports <- askUserChoices suggestions 35 | 36 | when (not . null $ noSuggestions) $ do 37 | putStrLn "------------- Could not find import for -------------" 38 | forM_ noSuggestions $ \(q, _) -> do 39 | putStrLn $ " - " ++ prettyPrint q 40 | putStrLn "" 41 | 42 | when (not . isEmpty $ chosenImports) $ do 43 | putStrLn "-------- Insert these imports into your file --------" 44 | putStrLn "" 45 | putStrLn $ unlines (showChosenImports chosenImports) 46 | where 47 | suffix = "names" 48 | 49 | askUserChoices :: [Suggestion] -> IO ChosenImports 50 | askUserChoices = resolveAllSuggestions askUserChoice 51 | -------------------------------------------------------------------------------- /exe/Halberd/UI.hs: -------------------------------------------------------------------------------- 1 | module Halberd.UI where 2 | 3 | import Control.Applicative 4 | import Control.Monad.State hiding (forM_) 5 | import Data.Foldable (forM_) 6 | import qualified Distribution.Text as Cabal 7 | import Language.Haskell.Exts.Annotated 8 | import Language.Haskell.Names 9 | import Safe 10 | import System.IO 11 | 12 | import Halberd.Types 13 | 14 | askUserChoice :: MonadIO m => QName (Scoped SrcSpan) -> [CanonicalSymbol] -> m CanonicalSymbol 15 | askUserChoice qname suggestions = liftIO $ 16 | do putStrLn $ prettyPrint qname ++ ":" 17 | forM_ (zip [1 :: Integer ..] suggestions) $ \(i, (_, modName, _)) -> putStrLn $ show i ++ ") " ++ Cabal.display modName 18 | putStrLn "" 19 | getChoice suggestions 20 | 21 | getChoice :: [a] -> IO a 22 | getChoice xs = withoutOutput go 23 | where 24 | go = 25 | do c <- getChar 26 | let mi = readMay [c] 27 | case (subtract 1) <$> mi >>= atMay xs of 28 | Nothing -> go 29 | Just x -> return x 30 | withoutOutput action = 31 | do buffering <- hGetBuffering stdin 32 | echo <- hGetEcho stdout 33 | hSetBuffering stdin NoBuffering 34 | hSetEcho stdout False 35 | result <- action 36 | hSetBuffering stdin buffering 37 | hSetEcho stdout echo 38 | return result 39 | -------------------------------------------------------------------------------- /halberd.cabal: -------------------------------------------------------------------------------- 1 | name: halberd 2 | version: 0.1.2.9 3 | license: BSD3 4 | license-file: LICENSE 5 | author: Erik Hesselink, Simon Meier, Tom Lokhorst, Roman Cheplyaka 6 | maintainer: hesselink@gmail.com 7 | category: Development 8 | build-type: Simple 9 | cabal-version: >=1.8 10 | synopsis: A tool to generate missing import statements for Haskell modules. 11 | description: This tool uses the Haskell Suite [0] to determine 12 | the unbound variables and types in your source 13 | code, and generate import statements for them. If 14 | there are multiple choices, it provides a simple 15 | interactive menu for you to choose from. See the 16 | home page for more details. 17 | 18 | [0] https://github.com/haskell-suite 19 | homepage: http://github.com/haskell-suite/halberd/ 20 | extra-source-files: CHANGELOG, README.md 21 | 22 | library 23 | build-depends: base >= 4.5 && < 4.8 24 | , containers >= 0.4 && < 0.6 25 | , haskell-packages == 0.2.* 26 | , haskell-names >= 0.2 && < 0.5 27 | , haskell-src-exts >= 1.14 && < 1.17 28 | , Cabal >= 1.16 && < 1.22 29 | , mtl >= 2.0 && < 2.3 30 | , safe == 0.3.* 31 | , syb >= 0.3 && < 0.5 32 | hs-source-dirs: src 33 | ghc-options: -Wall 34 | exposed-modules: Halberd.ChosenImports 35 | , Halberd.CollectNames 36 | , Halberd.LookupTable 37 | , Halberd.Suggestions 38 | , Halberd.Types 39 | other-modules: Data.Tuple.Utils 40 | , Language.Haskell.Exts.Utils 41 | 42 | executable halberd 43 | build-depends: base >= 4.5 && < 4.8 44 | , Cabal >= 1.16 && < 1.22 45 | , halberd 46 | , haskell-names >= 0.2 && < 0.5 47 | , haskell-packages == 0.2.* 48 | , haskell-src-exts >= 1.14 && < 1.17 49 | , mtl >= 2.0 && < 2.3 50 | , safe == 0.3.* 51 | , tagged >= 0.4 && < 0.8 52 | hs-source-dirs: exe 53 | main-is: Halberd.hs 54 | ghc-options: -Wall 55 | other-modules: Halberd.UI 56 | 57 | Test-suite halberd-tests 58 | build-depends: base >= 4.5 && < 4.8 59 | , Cabal >= 1.16 && < 1.22 60 | , containers >= 0.4 && < 0.6 61 | , halberd 62 | , HUnit == 1.2.* 63 | , test-framework == 0.8.* 64 | , test-framework-hunit == 0.3.* 65 | , haskell-names >= 0.2 && < 0.5 66 | , haskell-packages == 0.2.* 67 | , haskell-src-exts >= 1.14 && < 1.17 68 | , tagged >= 0.4 && < 0.8 69 | , split == 0.2.* 70 | , mtl >= 2.0 && < 2.3 71 | hs-source-dirs: tests 72 | main-is: Runner.hs 73 | type: exitcode-stdio-1.0 74 | ghc-options: -Wall 75 | 76 | Source-Repository head 77 | Type: git 78 | Location: git://github.com/haskell-suite/halberd.git 79 | -------------------------------------------------------------------------------- /src/Data/Tuple/Utils.hs: -------------------------------------------------------------------------------- 1 | module Data.Tuple.Utils where 2 | 3 | snd3 :: (a, b, c) -> b 4 | snd3 (_, y, _) = y 5 | 6 | trd3 :: (a, b, c) -> c 7 | trd3 (_, _, z) = z 8 | -------------------------------------------------------------------------------- /src/Halberd/ChosenImports.hs: -------------------------------------------------------------------------------- 1 | module Halberd.ChosenImports where 2 | 3 | import Control.Monad 4 | import Data.List 5 | import Data.Map (Map, insertWith) 6 | import Data.Monoid 7 | import Language.Haskell.Exts.Annotated hiding (name) 8 | import qualified Data.Map as Map 9 | import qualified Distribution.ModuleName as Cabal 10 | import qualified Distribution.Text as Cabal 11 | 12 | data ChosenImports = ChosenImports 13 | { qualifieds :: Map (ModuleName ()) Cabal.ModuleName 14 | , unqualifieds :: Map Cabal.ModuleName [Name ()] 15 | } deriving (Show, Eq) 16 | 17 | instance Monoid ChosenImports where 18 | mempty = ChosenImports 19 | { qualifieds = mempty 20 | , unqualifieds = mempty 21 | } 22 | i1 `mappend` i2 = ChosenImports 23 | { qualifieds = qualifieds i1 `mappend` qualifieds i2 24 | , unqualifieds = unqualifieds i1 `mappend` unqualifieds i2 25 | } 26 | 27 | lookupQualified :: ModuleName () -> ChosenImports -> Maybe Cabal.ModuleName 28 | lookupQualified qualification = Map.lookup qualification . qualifieds 29 | 30 | insertQualified :: ModuleName () -> Cabal.ModuleName -> ChosenImports -> ChosenImports 31 | insertQualified qualification module_ chosenImports = chosenImports 32 | { qualifieds = Map.insert qualification module_ (qualifieds chosenImports) } 33 | 34 | insertUnqualified :: Cabal.ModuleName -> Name () -> ChosenImports -> ChosenImports 35 | insertUnqualified module_ name chosenImports = chosenImports 36 | { unqualifieds = insertWith (++) module_ [name] (unqualifieds chosenImports) } 37 | 38 | insertChoice :: QName a -> Cabal.ModuleName -> ChosenImports -> ChosenImports 39 | insertChoice qname module_ = 40 | case qname of 41 | Qual _ qualification _ -> insertQualified (void qualification) module_ 42 | UnQual _ name -> insertUnqualified module_ (void name) 43 | Special _ _ -> error "impossible: insertChoice" 44 | 45 | isEmpty :: ChosenImports -> Bool 46 | isEmpty ci = Map.null (qualifieds ci) && Map.null (unqualifieds ci) 47 | 48 | showChosenImports :: ChosenImports -> [String] 49 | showChosenImports ci = showQualifieds (qualifieds ci) ++ showUnqualifieds (unqualifieds ci) 50 | 51 | showQualifieds :: Map (ModuleName ()) Cabal.ModuleName -> [String] 52 | showQualifieds = map (uncurry showQualified) . Map.toList 53 | 54 | showUnqualifieds :: Map Cabal.ModuleName [Name ()] -> [String] 55 | showUnqualifieds = map (uncurry showUnqualified) . Map.toList 56 | 57 | showQualified :: ModuleName () -> Cabal.ModuleName -> String 58 | showQualified qualification modName = 59 | intercalate " " 60 | [ "import" 61 | , "qualified" 62 | , Cabal.display modName 63 | , "as" 64 | , prettyPrint qualification 65 | ] 66 | showUnqualified :: Cabal.ModuleName -> [Name ()] -> String 67 | showUnqualified modName names = 68 | intercalate " " 69 | [ "import" 70 | , Cabal.display modName 71 | , "(" 72 | , intercalate ", " $ map prettyPrint names 73 | , ")" 74 | ] 75 | -------------------------------------------------------------------------------- /src/Halberd/CollectNames.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Halberd.CollectNames 3 | ( collectUnboundNames 4 | ) where 5 | 6 | import Control.Monad 7 | import Data.Either 8 | import Data.Generics 9 | import Language.Haskell.Exts.Annotated (SrcSpan) 10 | import Language.Haskell.Exts.Annotated.Syntax 11 | import Language.Haskell.Names 12 | 13 | ------------------------------------------------------------------------------ 14 | -- Collecting the (unbound) names 15 | ------------------------------------------------------------------------------ 16 | 17 | data NameSpace = TypeSpace | ValueSpace -- DON'T CHANGE THE ORDER 18 | deriving (Eq, Ord, Show) 19 | 20 | collectUnboundNames :: Module (Scoped SrcSpan) 21 | -> ([QName (Scoped SrcSpan)], [QName (Scoped SrcSpan)]) 22 | collectUnboundNames module_ = partitionEithers $ do 23 | (nameSpace, qname) <- namesFromAST module_ 24 | guard (qNameNotInScope qname) 25 | return $ case nameSpace of 26 | TypeSpace -> Left qname 27 | ValueSpace -> Right qname 28 | where 29 | qNameNotInScope :: QName (Scoped SrcSpan) -> Bool 30 | qNameNotInScope qname = case ann qname of 31 | Scoped (ScopeError ENotInScope {}) _ -> True 32 | _ -> False 33 | 34 | namesFromAST = everything (++) $ 35 | mkQ [] namesFromAsst 36 | `extQ` namesFromInstHead 37 | `extQ` namesFromType 38 | `extQ` namesFromExp 39 | `extQ` namesFromFieldUpdate 40 | #if MIN_VERSION_haskell_src_exts(1,15,0) 41 | `extQ` namesFromPromoted 42 | #endif 43 | 44 | namesFromAsst :: Asst l -> [(NameSpace, QName l)] 45 | namesFromAsst x = case x of 46 | ClassA _ qn _ -> [(TypeSpace, qn)] 47 | InfixA _ _ qn _ -> [(TypeSpace, qn)] 48 | IParam _ _ _ -> [] 49 | EqualP _ _ _ -> [] 50 | #if MIN_VERSION_haskell_src_exts(1,16,0) 51 | VarA _ _ -> [] 52 | ParenA _ _ -> [] 53 | #endif 54 | 55 | 56 | namesFromInstHead :: InstHead l -> [(NameSpace, QName l)] 57 | namesFromInstHead x = case x of 58 | #if MIN_VERSION_haskell_src_exts(1,16,0) 59 | IHCon _ qn -> [(TypeSpace, qn)] 60 | IHInfix _ _ qn -> [(TypeSpace, qn)] 61 | IHParen _ _ -> [] 62 | IHApp _ _ _ -> [] 63 | #else 64 | IHead _ qn _ -> [(TypeSpace, qn)] 65 | IHInfix _ _ qn _ -> [(TypeSpace, qn)] 66 | IHParen _ _ -> [] 67 | #endif 68 | 69 | namesFromType :: Type l -> [(NameSpace, QName l)] 70 | namesFromType x = case x of 71 | TyForall _ _ _ _ -> [] 72 | TyFun _ _ _ -> [] 73 | TyTuple _ _ _ -> [] 74 | TyList _ _ -> [] 75 | TyApp _ _ _ -> [] 76 | TyVar _ _ -> [] 77 | TyCon _ qn -> [(TypeSpace, qn)] 78 | TyParen _ _ -> [] 79 | TyInfix _ _ qn _ -> [(TypeSpace, qn)] 80 | TyKind _ _ _ -> [] 81 | #if MIN_VERSION_haskell_src_exts(1,15,0) 82 | TyPromoted _ _ -> [] 83 | #if MIN_VERSION_haskell_src_exts(1,16,0) 84 | TyParArray _ _ -> [] 85 | TyEquals _ _ _ -> [] 86 | TySplice _ _ -> [] 87 | TyBang _ _ _ -> [] 88 | #endif 89 | 90 | namesFromPromoted :: Promoted l -> [(NameSpace, QName l)] 91 | namesFromPromoted x = case x of 92 | PromotedInteger{} -> [] 93 | PromotedString{} -> [] 94 | PromotedCon _ _ qn -> [(TypeSpace, qn)] 95 | PromotedList{} -> [] 96 | PromotedTuple{} -> [] 97 | PromotedUnit{} -> [] 98 | #endif 99 | 100 | namesFromExp :: Exp l -> [(NameSpace, QName l)] 101 | namesFromExp x = case x of 102 | Var _ qn -> [(ValueSpace, qn)] 103 | IPVar _ _ -> [] 104 | Con _ qn -> [(ValueSpace, qn)] 105 | Lit _ _ -> [] 106 | InfixApp _ _ _ _ -> [] 107 | App _ _ _ -> [] 108 | NegApp _ _ -> [] 109 | Lambda _ _ _ -> [] 110 | Let _ _ _ -> [] 111 | If _ _ _ _ -> [] 112 | #if MIN_VERSION_haskell_src_exts(1,15,0) 113 | MultiIf _ _ -> [] 114 | #endif 115 | Case _ _ _ -> [] 116 | Do _ _ -> [] 117 | MDo _ _ -> [] 118 | Tuple _ _ _ -> [] 119 | TupleSection _ _ _ -> [] 120 | List _ _ -> [] 121 | Paren _ _ -> [] 122 | LeftSection _ _ _ -> [] 123 | RightSection _ _ _ -> [] 124 | RecConstr _ qn _ -> [(ValueSpace, qn)] 125 | RecUpdate _ _ _ -> [] 126 | EnumFrom _ _ -> [] 127 | EnumFromTo _ _ _ -> [] 128 | EnumFromThen _ _ _ -> [] 129 | EnumFromThenTo _ _ _ _ -> [] 130 | ListComp _ _ _ -> [] 131 | ParComp _ _ _ -> [] 132 | ExpTypeSig _ _ _ -> [] 133 | VarQuote _ qn -> [(ValueSpace, qn)] 134 | TypQuote _ qn -> [(TypeSpace, qn)] 135 | BracketExp _ _ -> [] 136 | SpliceExp _ _ -> [] 137 | QuasiQuote _ _ _ -> [] 138 | XTag _ _ _ _ _ -> [] 139 | XETag _ _ _ _ -> [] 140 | XPcdata _ _ -> [] 141 | XExpTag _ _ -> [] 142 | XChildTag _ _ -> [] 143 | CorePragma _ _ _ -> [] 144 | SCCPragma _ _ _ -> [] 145 | GenPragma _ _ _ _ _ -> [] 146 | Proc _ _ _ -> [] 147 | LeftArrApp _ _ _ -> [] 148 | RightArrApp _ _ _ -> [] 149 | LeftArrHighApp _ _ _ -> [] 150 | RightArrHighApp _ _ _ -> [] 151 | #if MIN_VERSION_haskell_src_exts(1,15,0) 152 | LCase _ _ -> [] 153 | #endif 154 | #if MIN_VERSION_haskell_src_exts(1,16,0) 155 | ParArray _ _ -> [] 156 | ParArrayFromTo _ _ _ -> [] 157 | ParArrayFromThenTo _ _ _ _ -> [] 158 | ParArrayComp _ _ _ -> [] 159 | #endif 160 | 161 | 162 | namesFromFieldUpdate :: FieldUpdate l -> [(NameSpace, QName l)] 163 | namesFromFieldUpdate x = case x of 164 | FieldUpdate _ qn _ -> [(ValueSpace, qn)] 165 | FieldPun _ _ -> [] 166 | FieldWildcard _ -> [] 167 | -------------------------------------------------------------------------------- /src/Halberd/LookupTable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TupleSections #-} 2 | module Halberd.LookupTable where 3 | 4 | import Control.Arrow 5 | import Control.Monad hiding (forM_) 6 | import Data.Function 7 | import Data.List 8 | import Data.Maybe 9 | import Data.Map (Map) 10 | import qualified Data.Map as Map 11 | import Data.Monoid 12 | import Data.Ord 13 | import Data.Set (Set) 14 | import qualified Data.Set as Set 15 | import Distribution.HaskellSuite 16 | import qualified Distribution.InstalledPackageInfo as Cabal 17 | import Language.Haskell.Exts.Annotated 18 | import Language.Haskell.Names 19 | 20 | import Data.Tuple.Utils 21 | import Halberd.Types 22 | 23 | type LookupTable = Map String [CanonicalSymbol] 24 | 25 | mkLookupTables :: ModuleT Symbols IO (LookupTable, LookupTable) 26 | mkLookupTables = 27 | do pkgs <- getPackages 28 | (valueDefs, typeDefs) <- 29 | fmap mconcat $ forM pkgs $ \pkg -> 30 | fmap mconcat $ forM (Cabal.exposedModules pkg) $ \exposedModule -> do 31 | (Symbols values types) <- readModuleInfo (Cabal.libraryDirs pkg) exposedModule 32 | let mkDefs qname = Set.map ((toPackageRef pkg, exposedModule,) . origName) qname 33 | return (mkDefs values, mkDefs types) 34 | let valueTable = toLookupTable (gUnqual . trd3) valueDefs 35 | typeTable = toLookupTable (gUnqual . trd3) typeDefs 36 | return (valueTable, typeTable) 37 | where 38 | gUnqual (OrigName _ (GName _ n)) = n 39 | 40 | 41 | lookupDefinitions :: LookupTable -> QName (Scoped SrcSpan) -> [CanonicalSymbol] 42 | lookupDefinitions symbolTable qname = fromMaybe [] $ 43 | do n <- unQName qname 44 | Map.lookup n symbolTable 45 | where 46 | unQName (Qual _ _ n) = Just (strName n) 47 | unQName (UnQual _ n) = Just (strName n) 48 | unQName (Special _ _ ) = Nothing 49 | 50 | strName (Ident _ str) = str 51 | strName (Symbol _ str) = str 52 | 53 | 54 | toLookupTable :: Ord k => (a -> k) -> Set a -> Map k [a] 55 | toLookupTable key = Map.fromList 56 | . map (fst . head &&& map snd) 57 | . groupBy ((==) `on` fst) 58 | . sortBy (comparing fst) 59 | . map (key &&& id) 60 | . Set.toList 61 | -------------------------------------------------------------------------------- /src/Halberd/Suggestions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DoAndIfThenElse #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | module Halberd.Suggestions where 4 | 5 | import Control.Applicative 6 | import Control.Arrow 7 | import Control.Monad hiding (forM_) 8 | import Control.Monad.State hiding (forM_) 9 | import Data.Function 10 | import Data.List 11 | import Data.Maybe 12 | import qualified Data.Map as Map 13 | import Data.Monoid 14 | import Distribution.HaskellSuite 15 | import Language.Haskell.Exts.Annotated 16 | import Language.Haskell.Names 17 | import Safe 18 | 19 | import Data.Tuple.Utils 20 | import Halberd.ChosenImports 21 | import Halberd.CollectNames 22 | import Halberd.LookupTable 23 | import Halberd.Types 24 | import Language.Haskell.Exts.Utils 25 | 26 | type Suggestion = (QName (Scoped SrcSpan), [CanonicalSymbol]) 27 | 28 | suggestedImports :: Module SrcSpanInfo -> ModuleT Symbols IO [Suggestion] 29 | suggestedImports module_ = 30 | do (unboundTypes, unboundValues) <- uniques <$> findUnbound module_ 31 | (valueTable, typeTable) <- mkLookupTables 32 | let valueSuggestions = map (id &&& lookupDefinitions valueTable) unboundValues 33 | typeSuggestions = map (id &&& lookupDefinitions typeTable ) unboundTypes 34 | return $ valueSuggestions ++ typeSuggestions 35 | where 36 | uniques = unique *** unique 37 | unique = nubBy ((==) `on` void) 38 | 39 | type ChooseExternal m = QName (Scoped SrcSpan) -> [CanonicalSymbol] -> m CanonicalSymbol 40 | 41 | resolveAllSuggestions :: (Functor m, Monad m) => ChooseExternal m -> [Suggestion] -> m ChosenImports 42 | resolveAllSuggestions chooseExternal suggestions = execStateT (go suggestions) mempty 43 | where 44 | go sugs = do 45 | remaining <- resolveSuggestions sugs 46 | case remaining of 47 | [] -> return [] 48 | ((qname, modules):ss) -> do 49 | choice <- lift $ chooseExternal qname modules 50 | modify $ insertChoice qname (snd3 choice) 51 | go ss 52 | 53 | resolveSuggestions :: (Functor m, MonadState ChosenImports m) => [Suggestion] -> m [Suggestion] 54 | resolveSuggestions suggestions = 55 | do newSuggestions <- resolveSuggestionsOnePass suggestions 56 | if suggestions == newSuggestions 57 | then return newSuggestions 58 | else resolveSuggestions newSuggestions 59 | 60 | resolveSuggestionsOnePass :: (Functor m, MonadState ChosenImports m) => [Suggestion] -> m [Suggestion] 61 | resolveSuggestionsOnePass suggestions = fmap catMaybes . forM suggestions $ \suggestion@(qname, modules) -> 62 | do chosenModules <- get 63 | if alreadyChosen qname modules chosenModules 64 | then 65 | return Nothing 66 | else do 67 | case hasSingleOption qname modules chosenModules of 68 | Nothing -> return $ Just suggestion 69 | Just choice -> do 70 | modify $ insertChoice qname (snd3 choice) 71 | return Nothing 72 | where 73 | alreadyChosen qname modules chosenModules = fromMaybe False $ 74 | do q <- getQualification qname 75 | module_ <- lookupQualified q chosenModules 76 | return $ module_ `elem` map snd3 modules 77 | hasSingleOption _ [module_] _ = Just module_ 78 | hasSingleOption UnQual{} modules chosenModules | singleOrigName modules = 79 | headMay $ filter ((`Map.member` unqualifieds chosenModules) . snd3) modules 80 | hasSingleOption _ _ _ = Nothing 81 | singleOrigName = allEqual . map trd3 82 | allEqual [] = True 83 | allEqual (x:xs) = all (== x) xs 84 | 85 | findUnbound :: Module SrcSpanInfo -> ModuleT Symbols IO ([QName (Scoped SrcSpan)], [QName (Scoped SrcSpan)]) 86 | findUnbound module_ = collectUnboundNames <$> annotateModule Haskell98 [] (fmap srcInfoSpan module_) 87 | -------------------------------------------------------------------------------- /src/Halberd/Types.hs: -------------------------------------------------------------------------------- 1 | module Halberd.Types where 2 | 3 | import qualified Distribution.InstalledPackageInfo as Cabal 4 | import qualified Distribution.ModuleName as Cabal 5 | import qualified Distribution.Package as Cabal 6 | import Language.Haskell.Names 7 | 8 | type CanonicalSymbol = (PackageRef, Cabal.ModuleName, OrigName) 9 | 10 | data PackageRef = PackageRef 11 | { installedPackageId :: Cabal.InstalledPackageId 12 | , sourcePackageId :: Cabal.PackageId 13 | } deriving (Eq, Ord, Show) 14 | 15 | toPackageRef :: Cabal.InstalledPackageInfo_ m -> PackageRef 16 | toPackageRef pkgInfo = 17 | PackageRef { installedPackageId = Cabal.installedPackageId pkgInfo 18 | , sourcePackageId = Cabal.sourcePackageId pkgInfo 19 | } 20 | -------------------------------------------------------------------------------- /src/Language/Haskell/Exts/Utils.hs: -------------------------------------------------------------------------------- 1 | module Language.Haskell.Exts.Utils where 2 | 3 | import Control.Monad 4 | import Language.Haskell.Exts.Annotated 5 | 6 | getQualification :: QName a -> Maybe (ModuleName ()) 7 | getQualification (Qual _ q _) = Just $ void q 8 | getQualification _ = Nothing 9 | -------------------------------------------------------------------------------- /test.hs: -------------------------------------------------------------------------------- 1 | import Prelude 2 | 3 | main :: IO Int8 4 | main = do 5 | pure [1,2] $ \x -> print $ M.lookup x table 6 | return $ headNote "Impossible" [10] 7 | 8 | table :: M.Map String Int8 9 | table = M.fromList [("Odeca", 1), ("Hackathon",2)] 10 | 11 | f = liftM 12 | 13 | g = (<$>) 14 | -------------------------------------------------------------------------------- /tests/Runner.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE FlexibleInstances, OverloadedStrings #-} 3 | import Control.Applicative 4 | import Control.Monad 5 | import Control.Monad.State 6 | import Data.Char 7 | import Data.Monoid 8 | import Data.List.Split 9 | import Data.Proxy 10 | import Data.String 11 | import Distribution.HaskellSuite 12 | import Distribution.Simple.Compiler 13 | import Language.Haskell.Exts.Annotated hiding (fileName) 14 | import Language.Haskell.Names.Interfaces 15 | import Test.Framework (defaultMain) 16 | import Test.Framework.Providers.HUnit (testCase) 17 | import Test.HUnit (assertEqual, Assertion) 18 | import qualified Data.Map as Map 19 | import qualified Distribution.ModuleName as Cabal 20 | 21 | import Halberd.ChosenImports (ChosenImports (..)) 22 | import Halberd.Suggestions 23 | 24 | main :: IO () 25 | main = do 26 | pkgs <- concat <$> mapM (getInstalledPackages (Proxy :: Proxy NamesDB)) [UserPackageDB, GlobalPackageDB] 27 | defaultMain [ testCase "Collect unbound" (collectUnbound pkgs) 28 | , testCase "Resolve single option" (resolveSingleOption pkgs) 29 | , testCase "Resolve multiple options" (resolveMultiple pkgs) 30 | , testCase "Resolve multiple options (different order)" (resolveMultipleDifferentOrder pkgs) 31 | ] 32 | 33 | collectUnbound :: Packages -> Assertion 34 | collectUnbound pkgs = do 35 | (ParseOk module_) <- parseFile "tests/input/Unbound.hs" 36 | (unboundTypes, unboundValues) <- evalModuleT (findUnbound module_) pkgs "names" readInterface 37 | assertEqual "Unbound types" (void <$> unboundTypes) ["M.Map", "Int8"] 38 | assertEqual "Unbound values" (void <$> unboundValues) ["forM", "M.fromList"] 39 | 40 | testResolution :: FilePath -> ChosenImports -> Packages -> Assertion 41 | testResolution fileName expectedImports pkgs = do 42 | (ParseOk module_) <- parseFile fileName 43 | suggestions <- evalModuleT (suggestedImports module_) pkgs "names" readInterface 44 | let (newSuggestions, imports) = runState (resolveSuggestions suggestions) mempty 45 | assertEqual "resolved suggestions" [] newSuggestions 46 | assertEqual "chosen imports" expectedImports imports 47 | 48 | resolveSingleOption :: Packages -> Assertion 49 | resolveSingleOption = testResolution "tests/input/ResolveSingle.hs" 50 | ChosenImports { qualifieds = Map.fromList [] 51 | , unqualifieds = Map.fromList [("Control.Applicative", ["pure"])] 52 | } 53 | 54 | resolveMultiple :: Packages -> Assertion 55 | resolveMultiple = testResolution "tests/input/ResolveMultiple.hs" 56 | ChosenImports { qualifieds = Map.fromList [] 57 | , unqualifieds = Map.fromList [("Control.Applicative", ["<$>", "pure"])] 58 | } 59 | 60 | resolveMultipleDifferentOrder :: Packages -> Assertion 61 | resolveMultipleDifferentOrder = testResolution "tests/input/ResolveMultipleDifferentOrder.hs" 62 | ChosenImports { qualifieds = Map.fromList [] 63 | , unqualifieds = Map.fromList [("Control.Applicative", ["<$>", "pure"])] 64 | } 65 | 66 | -- Some instances to make it easier to write down expected values in 67 | -- assertions. 68 | 69 | instance IsString (QName ()) where 70 | fromString str = 71 | let parts = splitOn "." str 72 | in case parts of 73 | [nm] -> UnQual () (fromString nm) 74 | [qual,nm] -> Qual () (fromString qual) (fromString nm) 75 | _ -> error "Too many dots in IsString Name." 76 | 77 | instance IsString (ModuleName ()) where 78 | fromString = ModuleName () 79 | 80 | instance IsString (Name ()) where 81 | fromString str = 82 | if (isAlpha (head str) || head str == '_') 83 | then Ident () str 84 | else Symbol () str 85 | 86 | instance IsString Cabal.ModuleName where 87 | fromString = Cabal.fromString 88 | -------------------------------------------------------------------------------- /tests/input/ResolveMultiple.hs: -------------------------------------------------------------------------------- 1 | f = pure 2 | g = (<$>) 3 | -------------------------------------------------------------------------------- /tests/input/ResolveMultipleDifferentOrder.hs: -------------------------------------------------------------------------------- 1 | g = (<$>) 2 | f = pure 3 | -------------------------------------------------------------------------------- /tests/input/ResolveSingle.hs: -------------------------------------------------------------------------------- 1 | f = pure 2 | -------------------------------------------------------------------------------- /tests/input/Unbound.hs: -------------------------------------------------------------------------------- 1 | main :: IO (M.Map Int8 String) 2 | main = do 3 | xs <- forM [1,2,3] $ \i -> (i, print i) 4 | return (M.fromList xs) 5 | --------------------------------------------------------------------------------