halberd (empty) → 0.1
raw patch · 6 files changed
+364/−0 lines, 6 filesdep +Cabaldep +basedep +containerssetup-changed
Dependencies added: Cabal, base, containers, filepath, haskell-names, haskell-packages, haskell-src-exts, mtl, safe, syb, tagged
Files
- CHANGELOG +2/−0
- LICENSE +30/−0
- README.md +90/−0
- Setup.hs +2/−0
- halberd.cabal +39/−0
- src/Halberd.hs +201/−0
+ CHANGELOG view
@@ -0,0 +1,2 @@+0.1:+ * Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Erik Hesselink++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Erik Hesselink nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,90 @@+Halberd: generating imports+==========++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.++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.++The imports generated are either qualified, if the unbound function looks like `M.lookup`, or explicit, if it looks like `void`.++Example+----------++As an example, say you have written the following (nonsensical and type incorrect) Haskell file called `test.hs`:++``` haskell+main :: IO Int8+main = do+ forM_ [1,2] $ \x -> print $ M.lookup x table+ liftM id $ return $ headNote "Impossible" [10]++table :: M.Map String Int8+table = M.fromList [("Odeca", 1), ("Hackathon",2)]+```++You can run Halberd on this by running `halberd test.hs`. It will prompt you with three questions:++```+forM_:+1) Control.Monad+2) Data.Foldable++M.lookup:+1) Data.List+2) GHC.List+3) Prelude+4) Data.IntMap+5) Data.IntMap.Lazy+6) Data.IntMap.Strict+7) Data.Map+8) Data.Map.Lazy+9) Data.Map.Strict++Int8:+1) Data.Int+2) Foreign+3) Foreign.Safe+4) GHC.Int+```++After making the choices by typing `1`, `7` and `1`, it generated the folling output:++``` haskell+------------- Could not find import for -------------+ - headNote++-------- Insert these imports into your file --------++import qualified Data.Map as M+import Control.Monad ( forM_, liftM )+import Data.Int ( Int8 )+```++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.++Installation+----------++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.++To install Halberd, just do++```+cabal install halberd+```++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.++Improvements+----------++Halberd is still in an unfinished state. Some planned improvements are:++* Smarter automatic choices.+* Editor integration.+* Easier installation of name databases (`haskell-names`).+* Integration with existing imports.+* Better choice UI.+* Choices based on type information (`haskell-type-exts`).++Contributions are welcome!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ halberd.cabal view
@@ -0,0 +1,39 @@+name: halberd+version: 0.1+license: BSD3+license-file: LICENSE+author: Erik Hesselink, Simon Meier, Tom Lokhorst, Roman Cheplyaka+maintainer: hesselink@gmail.com+category: Development+build-type: Simple+cabal-version: >=1.8+synopsis: A tool to generate missing import statements for Haskell modules.+description: This tool uses <https://github.com/haskell-suite+ the Haskell Suite> to determine the unbound+ variables and types in your source code, and+ generate import statements for them. If there are+ multiple choices, it provides a simple+ interactive menu for you to choose from. See the+ home page for more details.+homepage: http://github.com/haskell-suite/halberd/+extra-source-files: CHANGELOG, README.md++executable halberd+ build-depends: base >= 4.5 && < 4.7+ , containers >= 0.4 && < 0.6+ , haskell-packages == 0.2.*+ , haskell-names == 0.2.*+ , haskell-src-exts == 1.14.*+ , Cabal >= 1.17 && < 1.19+ , filepath == 1.3.*+ , mtl >= 2.0 && < 2.2+ , tagged >= 0.4 && < 0.8+ , safe == 0.3.*+ , syb >= 0.3 && < 0.5+ hs-source-dirs: src+ main-is: Halberd.hs+ ghc-options: -Wall++Source-Repository head+ Type: git+ Location: git://github.com/haskell-suite/halberd.git
+ src/Halberd.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DoAndIfThenElse #-}++import Control.Applicative+import Control.Arrow+import Control.Monad hiding (forM_)+import Control.Monad.State hiding (forM_)+import Data.Foldable (forM_)+import Data.Function+import Data.List+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Monoid+import Data.Ord+import Data.Proxy+import Data.Set (Set)+import qualified Data.Set as Set+import Distribution.HaskellSuite+import qualified Distribution.InstalledPackageInfo as Cabal+import qualified Distribution.ModuleName as Cabal+import qualified Distribution.Package as Cabal+import Distribution.Simple.Compiler+import qualified Distribution.Text as Cabal+import Language.Haskell.Exts.Annotated+import Language.Haskell.Names+import Language.Haskell.Names.Imports ()+import Language.Haskell.Names.Interfaces+import Safe+import System.Environment+import System.Exit+import System.IO++import Halberd.ChosenImports+import Halberd.CollectNames (collectUnboundNames)+import Halberd.Import+import Language.Haskell.Exts.Utils++main :: IO ()+main =+ do args <- getArgs+ case args of+ [] -> do+ putStrLn "Usage: halberd <SOURCEFILE>"+ exitFailure+ (file:_) -> do+ (ParseOk module_) <- parseFile file+ pkgs <- concat <$>+ mapM+ (getInstalledPackages (Proxy :: Proxy NamesDB))+ [UserPackageDB, GlobalPackageDB, SpecificPackageDB "/Users/erik/doc/haskell-suite/.cabal-sandbox/x86_64-osx-haskell-names-0.1-packages.conf.d"]+ allSuggestions <- evalModuleT (suggestedImports module_) pkgs suffix readInterface++ let (suggestions, noSuggestions) = partition (not . null . snd) allSuggestions++ choices <- flip evalStateT mempty $ askUserChoices suggestions++ let allImports = map (uncurry toImport . second snd3) choices+ let imports = mergeExplicitImports allImports++ when (not . null $ noSuggestions) $ do+ putStrLn "------------- Could not find import for -------------"+ forM_ noSuggestions $ \(q, _) -> do+ putStrLn $ " - " ++ prettyPrint q+ putStrLn ""++ when (not . null $ imports) $ do+ putStrLn "-------- Insert these imports into your file --------"+ putStrLn ""+ putStrLn $ unlines (map showImport imports)+ where+ suffix = "names"++type Suggestion = (QName (Scoped SrcSpan), [CanonicalSymbol])+type Choice = (QName (Scoped SrcSpan), CanonicalSymbol)++suggestedImports :: Module SrcSpanInfo -> ModuleT Symbols IO [Suggestion]+suggestedImports module_ =+ do (unboundTypes, unboundValues) <- uniques <$> findUnbound module_+ (valueTable, typeTable) <- mkLookupTables+ let valueSuggestions = map (id &&& lookupDefinitions valueTable) unboundValues+ typeSuggestions = map (id &&& lookupDefinitions typeTable ) unboundTypes+ return $ valueSuggestions ++ typeSuggestions+ where+ uniques = unique *** unique+ unique = nubBy ((==) `on` void)++askUserChoices :: [Suggestion] -> StateT ChosenImports IO [Choice]+askUserChoices suggestions = fmap catMaybes . forM suggestions $ \(qname, modules) ->+ do chosenModules <- get+ if alreadyChosen qname modules chosenModules+ then+ return Nothing+ else do+ choice <- case hasSingleOption qname modules chosenModules of+ Just singleOption -> return singleOption+ Nothing -> askUserChoice qname modules+ modify $ insertChoice qname (snd3 choice)+ return $ Just (qname, choice)+ where+ alreadyChosen qname modules chosenModules = fromMaybe False $+ do q <- getQualification qname+ module_ <- lookupQualified q chosenModules+ return $ module_ `elem` map snd3 modules+ hasSingleOption _ [module_] _ = Just module_+ hasSingleOption UnQual{} modules chosenModules | singleOrigName modules =+ headMay $ filter ((`elem` unqualifieds chosenModules) . snd3) modules+ hasSingleOption _ _ _ = Nothing+ singleOrigName = allEqual . map trd3+ allEqual [] = True+ allEqual (x:xs) = all (== x) xs++askUserChoice :: MonadIO m => QName (Scoped SrcSpan) -> [CanonicalSymbol] -> m CanonicalSymbol+askUserChoice qname suggestions = liftIO $+ do putStrLn $ prettyPrint qname ++ ":"+ forM_ (zip [1 :: Integer ..] suggestions) $ \(i, (_, modName, _)) -> putStrLn $ show i ++ ") " ++ Cabal.display modName+ putStrLn ""+ getChoice suggestions++getChoice :: [a] -> IO a+getChoice xs = withoutOutput go+ where+ go =+ do c <- getChar+ let mi = readMay [c]+ case (subtract 1) <$> mi >>= atMay xs of+ Nothing -> go+ Just x -> return x+ withoutOutput action =+ do buffering <- hGetBuffering stdin+ echo <- hGetEcho stdout+ hSetBuffering stdin NoBuffering+ hSetEcho stdout False+ result <- action+ hSetBuffering stdin buffering+ hSetEcho stdout echo+ return result++type CanonicalSymbol = (PackageRef, Cabal.ModuleName, OrigName)++data PackageRef = PackageRef+ { installedPackageId :: Cabal.InstalledPackageId+ , sourcePackageId :: Cabal.PackageId+ } deriving (Eq, Ord, Show)++toPackageRef :: Cabal.InstalledPackageInfo_ m -> PackageRef+toPackageRef pkgInfo =+ PackageRef { installedPackageId = Cabal.installedPackageId pkgInfo+ , sourcePackageId = Cabal.sourcePackageId pkgInfo+ }++findUnbound :: Module SrcSpanInfo -> ModuleT Symbols IO ([QName (Scoped SrcSpan)], [QName (Scoped SrcSpan)])+findUnbound module_ = collectUnboundNames <$> annotateModule Haskell98 [] (fmap srcInfoSpan module_)++type LookupTable = Map String [CanonicalSymbol]++mkLookupTables :: ModuleT Symbols IO (LookupTable, LookupTable)+mkLookupTables =+ do pkgs <- getPackages+ (valueDefs, typeDefs) <-+ fmap mconcat $ forM pkgs $ \pkg ->+ fmap mconcat $ forM (Cabal.exposedModules pkg) $ \exposedModule -> do+ (Symbols values types) <- readModuleInfo (Cabal.libraryDirs pkg) exposedModule+ let mkDefs qname = Set.map ((toPackageRef pkg, exposedModule,) . origName) qname+ return (mkDefs values, mkDefs types)+ let valueTable = toLookupTable (gUnqual . trd3) valueDefs+ typeTable = toLookupTable (gUnqual . trd3) typeDefs+ return (valueTable, typeTable)+ where+ gUnqual (OrigName _ (GName _ n)) = n+++lookupDefinitions :: Map String [CanonicalSymbol] -> QName (Scoped SrcSpan) -> [CanonicalSymbol]+lookupDefinitions symbolTable qname = fromMaybe [] $+ do n <- unQName qname+ Map.lookup n symbolTable+ where+ unQName (Qual _ _ n) = Just (strName n)+ unQName (UnQual _ n) = Just (strName n)+ unQName (Special _ _ ) = Nothing++ strName (Ident _ str) = str+ strName (Symbol _ str) = str+++toLookupTable :: Ord k => (a -> k) -> Set a -> Map k [a]+toLookupTable key = Map.fromList+ . map (fst . head &&& map snd)+ . groupBy ((==) `on` fst)+ . sortBy (comparing fst)+ . map (key &&& id)+ . Set.toList++snd3 :: (a, b, c) -> b+snd3 (_, y, _) = y++trd3 :: (a, b, c) -> c+trd3 (_, _, z) = z